From 4bf9c28f1f4af0bb74f8a04179656c4079e5ee07 Mon Sep 17 00:00:00 2001 From: Pawel Piatkowski Date: Sat, 9 Feb 2019 13:51:22 +0100 Subject: [PATCH 1/2] Add dispatch mechanism for geocoding backends --- R/add_coordinates.R | 52 +++++++++++++++++++++++++++++-- man/add_coordinates.Rd | 8 +++-- man/get_geocoding_function.Rd | 21 +++++++++++++ man/nominatim_backend_function.Rd | 20 ++++++++++++ 4 files changed, 96 insertions(+), 5 deletions(-) create mode 100644 man/get_geocoding_function.Rd create mode 100644 man/nominatim_backend_function.Rd diff --git a/R/add_coordinates.R b/R/add_coordinates.R index 791ec9f..3e5f7a6 100644 --- a/R/add_coordinates.R +++ b/R/add_coordinates.R @@ -11,6 +11,8 @@ #' and latitudes, respectively (default: "lon" and "lat") or a data frame with longitude and latitude columns. #' @param overwrite If TRUE, retrieves all geocodes, even those already #' retrieved. If FALSE (default), overwrites only NAs. +#' @param backend Geocoding backend. See \link{get_geocoding_function}. +#' @param ... Optional parameters passed to the geocoding function. #' #' @return An updated `epiflows` object. #' @md @@ -40,12 +42,18 @@ add_coordinates <- function(x, coordinates = c("lon", "lat"), loc_column = "id", - overwrite = FALSE) { + overwrite = FALSE, + backend = "nominatim", + ...) { if (!inherits(x, "epiflows")) { efprint <- as.character(deparse(substitute(x))) stop(sprintf("%s must be an object of class epiflows", efprint)) } + geocoding_fun <- get_geocoding_function(backend) + if (!is.function(geocoding_fun)) { + stop("Invalid geocoding function. Please specify a supported backend.") + } if (!is.null(x$vars$coordinates) && !overwrite) { stop("coordinates are present in the object. Use `overwrite = TRUE` to replace them.") } @@ -81,12 +89,50 @@ add_coordinates <- function(x, # overwrite only rows with NA lon and lat which_rows <- !complete.cases(get_coordinates(x)) if (any(which_rows)) { - x$linelist[which_rows, coordinates] <- ggmap::geocode(the_locations[which_rows]) + x$linelist[which_rows, coordinates] <- geocoding_fun(the_locations[which_rows], ...) } } else { # Otherwise, get all geocodes and write them to lon/lat columns - x$linelist[, coordinates] <- ggmap::geocode(as.character(the_locations)) + x$linelist[, coordinates] <- geocoding_fun(as.character(the_locations), ...) } } x } + +#' Get geocoding function +#' +#' Retrieves a function used by \link{add_coordinates} to geocode coordinates +#' for locations from an `epiflows` object. +#' +#' @param backend Either a function, or a character string pointing to one of +#' the supported geocoding backends. If `backend` is a function, it should +#' accept a vector of character strings as input (optional parameters can also +#' be passed from \code{add_coordinates()}) and return a data frame or a tibble. +#' +#' @return A function object. +get_geocoding_function <- function(backend) { + if (is.function(backend)) { + backend + } else { + switch( + backend, + "nominatim" = nominatim_backend_function, + "ggmap" = ggmap::geocode, + stop("Please specify a geocoding backend. Supported backends: nominatim, ggmap") + ) + } +} + +#' Nominatim geocoding backend +#' +#' Wrapper for Nominatim geocoding function provided by `nominatim` package. +#' See the documentation at https://github.com/hrbrmstr/nominatim for details. +#' +#' @param query Geocoding query. +#' @param ... Optional parameters. +#' +#' @return A data frame with two columns: `lat` and `lon`. +nominatim_backend_function <- function(query, ...) { + output <- nominatim::osm_geocode(query = query, ...) + output[c("lat", "lon")] +} diff --git a/man/add_coordinates.Rd b/man/add_coordinates.Rd index d890b45..acfead6 100644 --- a/man/add_coordinates.Rd +++ b/man/add_coordinates.Rd @@ -7,7 +7,7 @@ \title{Add/Retrieve location coordinates} \usage{ add_coordinates(x, coordinates = c("lon", "lat"), loc_column = "id", - overwrite = FALSE) + overwrite = FALSE, backend = "nominatim", ...) get_coordinates(x, ...) @@ -25,11 +25,15 @@ and latitudes, respectively (default: "lon" and "lat") or a data frame with long \item{overwrite}{If TRUE, retrieves all geocodes, even those already retrieved. If FALSE (default), overwrites only NAs.} -\item{...}{unused} +\item{backend}{Geocoding backend. See \link{get_geocoding_function}.} + +\item{...}{Optional parameters passed to the geocoding function.} \item{location}{a character specifying a single location to return as a vector of coordinates. You cannot specify multiple locations with this parameter. Defaults to `NULL`, indicating all locations.} + +\item{...}{unused} } \value{ An updated \code{epiflows} object. diff --git a/man/get_geocoding_function.Rd b/man/get_geocoding_function.Rd new file mode 100644 index 0000000..390fc7b --- /dev/null +++ b/man/get_geocoding_function.Rd @@ -0,0 +1,21 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/add_coordinates.R +\name{get_geocoding_function} +\alias{get_geocoding_function} +\title{Get geocoding function} +\usage{ +get_geocoding_function(backend) +} +\arguments{ +\item{backend}{Either a function, or a character string pointing to one of +the supported geocoding backends. If `backend` is a function, it should +accept a vector of character strings as input (optional parameters can also +be passed from \code{add_coordinates()}) and return a data frame or a tibble.} +} +\value{ +A function object. +} +\description{ +Retrieves a function used by \link{add_coordinates} to geocode coordinates +for locations from an `epiflows` object. +} diff --git a/man/nominatim_backend_function.Rd b/man/nominatim_backend_function.Rd new file mode 100644 index 0000000..4d5e1c3 --- /dev/null +++ b/man/nominatim_backend_function.Rd @@ -0,0 +1,20 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/add_coordinates.R +\name{nominatim_backend_function} +\alias{nominatim_backend_function} +\title{Nominatim geocoding backend} +\usage{ +nominatim_backend_function(query, ...) +} +\arguments{ +\item{query}{Geocoding query.} + +\item{...}{Optional parameters.} +} +\value{ +A data frame with two columns: `lat` and `lon`. +} +\description{ +Wrapper for Nominatim geocoding function provided by `nominatim` package. +See the documentation at https://github.com/hrbrmstr/nominatim for details. +} From 74ff20289bc3025e89f002161fad3fe7a0ed6fd1 Mon Sep 17 00:00:00 2001 From: Pawel Piatkowski Date: Sat, 9 Feb 2019 14:02:14 +0100 Subject: [PATCH 2/2] Move ggmap and nominatim to Suggested --- DESCRIPTION | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 662e360..36b929c 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -25,7 +25,6 @@ Depends: Imports: epicontacts, leaflet, - ggmap, geosphere, ggplot2, tibble, @@ -41,7 +40,9 @@ Suggests: outbreaks, vdiffr, curl, - rmarkdown + rmarkdown, + nominatim, + ggmap RoxygenNote: 6.1.0 URL: https://www.repidemicsconsortium.org/epiflows BugReports: https://github.com/reconhub/epiflows/issues