Bring back amenities function

CITATION.cff

@@ -109,21 +109,6 @@ references:
  - type: url
  value: https://arxiv.org/abs/1403.2805
  version: '>= 1.7.0'
-- type: software
- title: lifecycle
- abstract: 'lifecycle: Manage the Life Cycle of your Package Functions'
- notes: Imports
- url: https://lifecycle.r-lib.org/
- repository: https://CRAN.R-project.org/package=lifecycle
- authors:
- - family-names: Henry
- given-names: Lionel
- email: [email protected]
- - family-names: Wickham
- given-names: Hadley
- email: [email protected]
- orcid: https://orcid.org/0000-0003-4757-117X
- year: '2024'
 - type: software
  title: sf
  abstract: 'sf: Simple Features for R'
@@ -211,6 +196,21 @@ references:
  email: [email protected]
  orcid: https://orcid.org/0000-0003-0645-5666
  year: '2024'
+- type: software
+ title: lifecycle
+ abstract: 'lifecycle: Manage the Life Cycle of your Package Functions'
+ notes: Suggests
+ url: https://lifecycle.r-lib.org/
+ repository: https://CRAN.R-project.org/package=lifecycle
+ authors:
+ - family-names: Henry
+ given-names: Lionel
+ email: [email protected]
+ - family-names: Wickham
+ given-names: Hadley
+ email: [email protected]
+ orcid: https://orcid.org/0000-0003-4757-117X
+ year: '2024'
 - type: software
  title: rmarkdown
  abstract: 'rmarkdown: Dynamic Documents for R'

DESCRIPTION

@@ -24,13 +24,13 @@ Depends:
 Imports: 
  dplyr (>= 1.0.0),
  jsonlite (>= 1.7.0),
- lifecycle,
  sf (>= 0.9.0),
  utils
 Suggests: 
  arcgeocoder,
  ggplot2 (>= 3.0.0),
  knitr,
+ lifecycle,
  rmarkdown,
  testthat (>= 3.0.0),
  tibble,

NEWS.md

@@ -4,6 +4,9 @@
 
  - `geo_lite_struct()` and `geo_lite_struct_sf()` for performing structured
  queries.
+ - Bring back `geo_amenity()` and `geo_amenity_sf()` as a wrapper of
+ `geo_lite_struct()` / `geo_lite_struct_sf(),` so now are more robust and
+ compatible with **sf** objects.
 
 - It is possible to use **nominatimlite** with local server thanks to the new
  argument `nominatim_server` (#42 \@alexwhitedatamine).

R/geo_amenity.R

@@ -0,0 +1,144 @@
+#' Geocode amenities
+#'
+#' @description
+#' This function search [amenities][osm_amenities] as defined by OpenStreetMap
+#' on a restricted area defined by a bounding box in the form
+#' `(<xmin>, <ymin>, <xmax>, <ymax>)`. This function returns the
+#' [`tibble`][tibble::tibble] associated with the query, see [geo_amenity_sf()]
+#' for retrieving the data as a spatial object ([`sf`][sf::st_sf] format).
+#'
+#' @family amenity
+#' @family geocoding
+#'
+#' @param bbox The bounding box (viewbox) used to limit the search. It could be:
+#' - A numeric vector of **longitude** (`x`) and **latitude** (`y`)
+#' `(xmin, ymin, xmax, ymax)`. See **Details**.
+#' - A [`sf`][sf::st_sf] or [`sfc`][sf::st_sfc] object.
+#' @param amenity A `character` (or a vector of `character`s) with the
+#' amenities to be geolocated (i.e. `c("pub", "restaurant")`). See
+#' [nominatimlite::osm_amenities].
+#' @param strict Logical `TRUE/FALSE`. Force the results to be included inside
+#' the `bbox`. Note that Nominatim default behavior may return results located
+#' outside the provided bounding box.
+#' @inheritParams geo_lite_struct
+#' @inheritParams geo_lite
+#'
+#' @details
+#'
+#' Bounding boxes can be located using different online tools, as
+#' [Bounding Box Tool](https://boundingbox.klokantech.com/).
+#'
+#' For a full list of valid amenities see
+#' <https://wiki.openstreetmap.org/wiki/Key:amenity> and [osm_amenities].
+#'
+#' See <https://nominatim.org/release-docs/latest/api/Search/> for additional
+#' parameters to be passed to `custom_query`.
+#'
+#'
+#' @return
+#'
+#' ```{r child = "man/chunks/tibbleout.Rmd"}
+#' ```
+#'
+#' @export
+#'
+#' @examplesIf nominatim_check_access()
+#' \donttest{
+#' # Times Square, NY, USA
+#' bbox <- c(
+#' -73.9894467311, 40.75573629,
+#' -73.9830630737, 40.75789245
+#' )
+#'
+#' geo_amenity(
+#' bbox = bbox,
+#' amenity = "restaurant"
+#' )
+#'
+#' # Several amenities
+#' geo_amenity(
+#' bbox = bbox,
+#' amenity = c("restaurant", "pub")
+#' )
+#'
+#' # Increase limit and use with strict
+#' geo_amenity(
+#' bbox = bbox,
+#' amenity = c("restaurant", "pub"),
+#' limit = 10,
+#' strict = TRUE
+#' )
+#' }
+geo_amenity <- function(
+ bbox, amenity, lat = "lat", long = "lon", limit = 1, full_results = FALSE,
+ return_addresses = TRUE, verbose = FALSE,
+ nominatim_server = "https://nominatim.openstreetmap.org/",
+ progressbar = TRUE, custom_query = list(), strict = FALSE) {
+ if (limit > 50) {
+ message(paste(
+ "Nominatim provides 50 results as a maximum. ",
+ "Your query may be incomplete"
+ ))
+ limit <- min(50, limit)
+ }
+
+ # bbox types
+ if (any(inherits(bbox, "sf"), inherits(bbox, "sfc"))) {
+ tolonlat <- sf::st_transform(bbox, 4326)
+ bbox <- as.vector(sf::st_bbox(tolonlat))
+ }
+ bbox <- as.vector(bbox)
+
+ # Overwrite custom query
+ custom_query <- as.list(custom_query)
+ custom_query$viewbox <- bbox
+ custom_query$bounded <- TRUE
+
+ # Dedupe for query
+ key <- unique(amenity)
+
+ # Set progress bar
+ ntot <- length(key)
+ # Set progress bar if n > 1
+ progressbar <- all(progressbar, ntot > 1)
+ if (progressbar) {
+ pb <- txtProgressBar(min = 0, max = ntot, width = 50, style = 3)
+ }
+ seql <- seq(1, ntot, 1)
+
+ seql <- seq(1, ntot, 1)
+
+ all_res <- lapply(seql, function(x) {
+ ad <- key[x]
+ if (progressbar) {
+ setTxtProgressBar(pb, x)
+ }
+
+ geo_lite_struct(
+ amenity = ad, lat = lat, long = long, limit = limit,
+ full_results = full_results,
+ return_addresses = return_addresses, verbose = verbose,
+ nominatim_server = nominatim_server,
+ custom_query = custom_query
+ )
+ })
+ if (progressbar) close(pb)
+
+ all_res <- dplyr::bind_rows(all_res)
+
+ # Clean columns and names
+ nm <- names(all_res)
+ nm[nm == "q_amenity"] <- "amenity"
+ names(all_res) <- nm
+ all_res <- all_res[, !grepl("^q_", nm)]
+
+ if (strict) {
+ bbox_sf <- bbox_to_poly(bbox)
+ all_res_sf <- sf::st_as_sf(all_res, coords = c("lon", "lat"), crs = 4326)
+
+ int <- as.vector(sf::st_intersects(all_res_sf, bbox_sf, sparse = FALSE))
+ all_res <- all_res[int, ]
+ }
+
+ return(all_res)
+}