From 05efa31469da39463eb0d0a3e479a2a6b743403a Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Carlos=20Vergara-Hern=C3=A1ndez?= Date: Tue, 1 Aug 2017 13:53:26 +0200 Subject: [PATCH 01/11] rbind lists to data.frame --- R/utils.R | 8 ++++++++ 1 file changed, 8 insertions(+) diff --git a/R/utils.R b/R/utils.R index faabd70..bd64577 100644 --- a/R/utils.R +++ b/R/utils.R @@ -14,3 +14,11 @@ jsonp_to_json <- function(text) { text <- gsub("\\)$", "", text) return(text) } + +rbind_lists_df <- function(x, y) { + x_diff <- setdiff(colnames(x), colnames(y)) + y_diff <- setdiff(colnames(y), colnames(x)) + x[, c(as.character(y_diff))] <- NA + y[, c(as.character(x_diff))] <- NA + return(rbind(x, y)) +} From d7f85b9996e45c9767675ff9720790a896367e55 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Carlos=20Vergara-Hern=C3=A1ndez?= Date: Tue, 1 Aug 2017 13:56:17 +0200 Subject: [PATCH 02/11] Multiple queries in the same call --- R/cartociudad_geocode.R | 53 +++++++++++++++++----- R/cartociudad_reverse_geocode.R | 71 +++++++++++++++++------------- man/cartociudad_geocode.Rd | 12 +++-- man/cartociudad_reverse_geocode.Rd | 15 +++---- 4 files changed, 97 insertions(+), 54 deletions(-) diff --git a/R/cartociudad_geocode.R b/R/cartociudad_geocode.R index 8aadb90..4b543f4 100644 --- a/R/cartociudad_geocode.R +++ b/R/cartociudad_geocode.R @@ -18,7 +18,7 @@ #' @param output_format Character string. Output format of the query: "JSON" or #' "GeoJSON". #' -#' @return A data frame consisting of a single row per guess. See the reference +#' @return A data frame consisting of a single row per query. See the reference #' below for an explanation of the data frame columns. #' #' @author Carlos J. Gil Bellosta @@ -27,23 +27,54 @@ #' \url{http://www.cartociudad.es/recursos/Documentacion_tecnica/CARTOCIUDAD_ServiciosWeb.pdf} #' #' @examples -#' # using full address -#' my.address <- cartociudad_geocode(full_address = "plaza de cascorro 11, 28005 madrid") +#' # Query a single address +#' address <- "plaza de cascorro 11, 28005 madrid" +#' my.address <- cartociudad_geocode(full_address = address) +#' print(my.address) +#' +#' # Query multiple addresses +#' address <- c(address, "plaza del ayunamiento 1, valencia") +#' my.address <- cartociudad_geocode(full_address = address) #' print(my.address) #' #' @export #' cartociudad_geocode <- function(full_address, output_format = "JSON") { - api.args <- list(q = full_address, outputformat = output_format) + names_res <- c("id", "province", "muni", "type", "address", "postalCode", + "poblacion", "geom", "tip_via", "lat", "lng", + "portalNumber", "stateMsg", "state", "countryCode") + results <- as.data.frame( + matrix( + ncol = length(names_res), + nrow = length(full_address) + ) + ) + colnames(results) <- names_res + res_list <- list() + + for (i in seq_along(full_address)) { + api.args <- list(q = full_address[i], outputformat = output_format) ua <- get_cartociudad_user_agent() res <- httr::GET("http://www.cartociudad.es/geocoder/api/geocoder/findJsonp", query = api.args, ua) - httr::stop_for_status(res) - res <- jsonp_to_json(httr::content(res, as = "text", encoding = "UTF8")) - res <- jsonlite::fromJSON(res) - res <- as.data.frame(t(unlist(res)), stringsAsFactors = FALSE) - res[, c(grep("lat", names(res)), grep("lng", names(res)))] <- - apply(res[, c(grep("lat", names(res)), grep("lng", names(res)))], 2, as.numeric) - return(res) + if (httr::http_error(res)) { + warning("Error in query ", i, ": ", httr::http_status(res)$message) + results[i, "address"] <- full_address[i] + results[i, "state"] <- 0 + } else { + res <- jsonp_to_json(httr::content(res, as = "text", encoding = "UTF8")) + res <- jsonlite::fromJSON(res) + res_list[[i]] <- as.data.frame(t(unlist(res)), stringsAsFactors = FALSE) + } + } + + if (length(res_list) == 1) { + results <- res_list[[1]] + } else { + results <- do.call(rbind_lists_df, res_list) + } + + results[, c("lat", "lng")] <- apply(results[, c("lat", "lng")], 2, as.numeric) + return(results) } diff --git a/R/cartociudad_reverse_geocode.R b/R/cartociudad_reverse_geocode.R index d139521..46da932 100644 --- a/R/cartociudad_reverse_geocode.R +++ b/R/cartociudad_reverse_geocode.R @@ -16,15 +16,8 @@ #' @param longitude Point longitude in geographical coordinates (e.g., #' -3.7227241) #' -#' @return A list with the following items: -#' \item{tipo}{type of location.} -#' \item{tipo.via}{road type.} -#' \item{nombre.via}{road name.} -#' \item{num.via}{road number.} -#' \item{num.via.id}{internal id of this address in cartociudad database.} -#' \item{municipio}{town.} -#' \item{provincia}{province.} -#' \item{cod.postal}{zip code.} +#' @return A data frame consisting of a single row per query. See the reference +#' below for an explanation of the data frame columns. #' #' @author Luz Frias #' @@ -32,34 +25,50 @@ #' \url{http://www.cartociudad.es/recursos/Documentacion_tecnica/CARTOCIUDAD_ServiciosWeb.pdf} #' #' @examples +#' # Query one point #' cartociudad_reverse_geocode(40.473219, -3.7227241) #' +#' # Query multiple points +#' cartociudad_reverse_geocode(c(40.473219, 39.46979), c(-3.7227241, -0.376963)) +#' #' @export #' cartociudad_reverse_geocode <- function(latitude, longitude) { - - query.parms <- list( - lat = latitude, - lon = longitude + + stopifnot(length(latitude) == length(longitude)) + + names_res <- c("type", "tip_via", "address", "portalNumber", "id", + "muni", "province", "postalCode", "lat", "lng") + results <- as.data.frame( + matrix( + ncol = length(names_res), + nrow = length(latitude) + ) ) - + colnames(results) <- names_res + res_list <- list() + url <- "http://www.cartociudad.es/services/api/geocoder/reverseGeocode" ua <- get_cartociudad_user_agent() - - - res <- httr::GET(url, query = query.parms, ua) - httr::stop_for_status(res) - info <- httr::content(res) - # Parse the response - res <- list( - tipo = info$type, - tipo.via = info$tip_via, - nombre.via = info$address, - num.via = info$portalNumber, - num.via.id = info$id, - municipio = info$muni, - provincia = info$province, - cod.postal = info$postalCode - ) - return(res) + + for (i in seq_along(latitude)) { + query.parms <- list(lat = latitude[i], lon = longitude[i]) + res <- httr::GET(url, query = query.parms, ua) + + if (httr::http_error(res)) { + warning("Error in query ", i, ": ", httr::http_status(res)$message) + results[i, c("lat", "lng")] <- c(latitude[i], longitude[i]) + } else { + info <- httr::content(res) + res_list[[i]] <- as.data.frame(t(unlist(info)), stringsAsFactors = FALSE)[, names_res] + } + } + + if (length(res_list) == 1) { + results <- res_list[[1]] + } else { + results <- do.call(rbind_lists_df, res_list) + } + + return(results) } diff --git a/man/cartociudad_geocode.Rd b/man/cartociudad_geocode.Rd index 4b5ee32..52a7dd3 100644 --- a/man/cartociudad_geocode.Rd +++ b/man/cartociudad_geocode.Rd @@ -15,7 +15,7 @@ cause problems.} "GeoJSON".} } \value{ -A data frame consisting of a single row per guess. See the reference +A data frame consisting of a single row per query. See the reference below for an explanation of the data frame columns. } \description{ @@ -25,8 +25,14 @@ Geolocation of Spanish addresses via Cartociudad API calls, providing the name. } \examples{ -# using full address -my.address <- cartociudad_geocode(full_address = "plaza de cascorro 11, 28005 madrid") +# Query a single address +address <- "plaza de cascorro 11, 28005 madrid" +my.address <- cartociudad_geocode(full_address = address) +print(my.address) + +# Query multiple addresses +address <- c(address, "plaza del ayunamiento 1, valencia") +my.address <- cartociudad_geocode(full_address = address) print(my.address) } diff --git a/man/cartociudad_reverse_geocode.Rd b/man/cartociudad_reverse_geocode.Rd index 0c03928..efe905f 100644 --- a/man/cartociudad_reverse_geocode.Rd +++ b/man/cartociudad_reverse_geocode.Rd @@ -13,15 +13,8 @@ cartociudad_reverse_geocode(latitude, longitude) -3.7227241)} } \value{ -A list with the following items: -\item{tipo}{type of location.} -\item{tipo.via}{road type.} -\item{nombre.via}{road name.} -\item{num.via}{road number.} -\item{num.via.id}{internal id of this address in cartociudad database.} -\item{municipio}{town.} -\item{provincia}{province.} -\item{cod.postal}{zip code.} +A data frame consisting of a single row per query. See the reference + below for an explanation of the data frame columns. } \description{ Returns the address details of a geographical point in Spain. @@ -31,8 +24,12 @@ This function performs reverse geocoding of a location. It returns the details of the closest address in Spain. } \examples{ +# Query one point cartociudad_reverse_geocode(40.473219, -3.7227241) +# Query multiple points +cartociudad_reverse_geocode(c(40.473219, 39.46979), c(-3.7227241, -0.376963)) + } \references{ \url{http://www.cartociudad.es/recursos/Documentacion_tecnica/CARTOCIUDAD_ServiciosWeb.pdf} From f0a865c4320c8b109219085eed9bfcdda166d6b3 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Carlos=20Vergara-Hern=C3=A1ndez?= Date: Tue, 1 Aug 2017 15:26:46 +0200 Subject: [PATCH 03/11] Add package purrr to Imports - Drop rbind_lists_df function. - Add purrr:map_df() to rbind lists. - Minor fixes. --- DESCRIPTION | 2 +- R/cartociudad_geocode.R | 24 +++++------------------- R/cartociudad_reverse_geocode.R | 22 ++++++---------------- R/utils.R | 8 -------- 4 files changed, 12 insertions(+), 44 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 7fd24a5..204af03 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -9,7 +9,7 @@ Authors@R: c(person("Carlos J.", "Gil Bellosta", email="cgb@datanalytics.com", r Author: Carlos J. Gil Bellosta, Luz Frías Maintainer: Carlos J. Gil Bellosta Description: Access to Cartociudad cartography API, which provides mapping and other related services for Spain. -Imports: httr, jsonlite, xml2, plyr, geosphere +Imports: httr, jsonlite, xml2, plyr, geosphere, purrr Depends: R (>= 3.0.0) Suggests: ggmap, testthat URL: https://github.com/cjgb/caRtociudad diff --git a/R/cartociudad_geocode.R b/R/cartociudad_geocode.R index 4b543f4..821bdd8 100644 --- a/R/cartociudad_geocode.R +++ b/R/cartociudad_geocode.R @@ -40,17 +40,7 @@ #' @export #' cartociudad_geocode <- function(full_address, output_format = "JSON") { - names_res <- c("id", "province", "muni", "type", "address", "postalCode", - "poblacion", "geom", "tip_via", "lat", "lng", - "portalNumber", "stateMsg", "state", "countryCode") - results <- as.data.frame( - matrix( - ncol = length(names_res), - nrow = length(full_address) - ) - ) - colnames(results) <- names_res - res_list <- list() + res_list <- list() for (i in seq_along(full_address)) { api.args <- list(q = full_address[i], outputformat = output_format) @@ -60,8 +50,8 @@ cartociudad_geocode <- function(full_address, output_format = "JSON") { if (httr::http_error(res)) { warning("Error in query ", i, ": ", httr::http_status(res)$message) - results[i, "address"] <- full_address[i] - results[i, "state"] <- 0 + res_list[[i]] <- data.frame(address = full_address[i], + stringsAsFactors = FALSE) } else { res <- jsonp_to_json(httr::content(res, as = "text", encoding = "UTF8")) res <- jsonlite::fromJSON(res) @@ -69,12 +59,8 @@ cartociudad_geocode <- function(full_address, output_format = "JSON") { } } - if (length(res_list) == 1) { - results <- res_list[[1]] - } else { - results <- do.call(rbind_lists_df, res_list) - } - + results <- purrr::map_df(res_list, rbind) results[, c("lat", "lng")] <- apply(results[, c("lat", "lng")], 2, as.numeric) + return(results) } diff --git a/R/cartociudad_reverse_geocode.R b/R/cartociudad_reverse_geocode.R index 46da932..c32fb8d 100644 --- a/R/cartociudad_reverse_geocode.R +++ b/R/cartociudad_reverse_geocode.R @@ -39,14 +39,7 @@ cartociudad_reverse_geocode <- function(latitude, longitude) { names_res <- c("type", "tip_via", "address", "portalNumber", "id", "muni", "province", "postalCode", "lat", "lng") - results <- as.data.frame( - matrix( - ncol = length(names_res), - nrow = length(latitude) - ) - ) - colnames(results) <- names_res - res_list <- list() + res_list <- list() url <- "http://www.cartociudad.es/services/api/geocoder/reverseGeocode" ua <- get_cartociudad_user_agent() @@ -57,18 +50,15 @@ cartociudad_reverse_geocode <- function(latitude, longitude) { if (httr::http_error(res)) { warning("Error in query ", i, ": ", httr::http_status(res)$message) - results[i, c("lat", "lng")] <- c(latitude[i], longitude[i]) + res_list[[i]] <- data.frame(lat = latitude[i], lng = longitude[i], + stringsAsFactors = FALSE) } else { info <- httr::content(res) - res_list[[i]] <- as.data.frame(t(unlist(info)), stringsAsFactors = FALSE)[, names_res] + res_list[[i]] <- as.data.frame(t(unlist(info)), + stringsAsFactors = FALSE)[, names_res] } } - if (length(res_list) == 1) { - results <- res_list[[1]] - } else { - results <- do.call(rbind_lists_df, res_list) - } - + results <- purrr::map_df(res_list, rbind) return(results) } diff --git a/R/utils.R b/R/utils.R index bd64577..faabd70 100644 --- a/R/utils.R +++ b/R/utils.R @@ -14,11 +14,3 @@ jsonp_to_json <- function(text) { text <- gsub("\\)$", "", text) return(text) } - -rbind_lists_df <- function(x, y) { - x_diff <- setdiff(colnames(x), colnames(y)) - y_diff <- setdiff(colnames(y), colnames(x)) - x[, c(as.character(y_diff))] <- NA - y[, c(as.character(x_diff))] <- NA - return(rbind(x, y)) -} From 845f2ddf8dbc18490e3a84483c19a9b628442f82 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Carlos=20Vergara-Hern=C3=A1ndez?= Date: Wed, 2 Aug 2017 14:24:53 +0200 Subject: [PATCH 04/11] Better error handling in cartociudad_geocode() --- R/cartociudad_geocode.R | 42 +++++++++++++++++++++++++++-------------- 1 file changed, 28 insertions(+), 14 deletions(-) diff --git a/R/cartociudad_geocode.R b/R/cartociudad_geocode.R index 821bdd8..7164144 100644 --- a/R/cartociudad_geocode.R +++ b/R/cartociudad_geocode.R @@ -40,25 +40,39 @@ #' @export #' cartociudad_geocode <- function(full_address, output_format = "JSON") { - res_list <- list() - for (i in seq_along(full_address)) { - api.args <- list(q = full_address[i], outputformat = output_format) - ua <- get_cartociudad_user_agent() - res <- httr::GET("http://www.cartociudad.es/geocoder/api/geocoder/findJsonp", - query = api.args, ua) + stopifnot(class(full_address) == "character") + stopifnot(length(full_address) >= 1) + no_geocode <- which(nchar(full_address) == 0) + res_list <- list() - if (httr::http_error(res)) { - warning("Error in query ", i, ": ", httr::http_status(res)$message) - res_list[[i]] <- data.frame(address = full_address[i], - stringsAsFactors = FALSE) + for (i in seq_along(full_address)) { + if (!i %in% no_geocode) { + api.args <- list(q = full_address[i], outputformat = output_format) + ua <- get_cartociudad_user_agent() + res <- httr::GET("http://www.cartociudad.es/geocoder/api/geocoder/findJsonp", + query = api.args, ua) + if (httr::http_error(res)) { + warning("Error in query ", i, ": ", httr::http_status(res)$message) + res_list[[i]] <- data.frame(address = full_address[i], + stringsAsFactors = FALSE) + } else { + res <- jsonp_to_json(httr::content(res, as = "text", encoding = "UTF8")) + res <- jsonlite::fromJSON(res) + res <- res[-which(names(res) %in% c("geom", "countryCode", "refCatastral"))] + if (length(res) == 0) { + warning("The query has 0 results.") + res_list[[i]] <- data.frame(address = full_address[i], + stringsAsFactors = FALSE) + } else { + res_list[[i]] <- as.data.frame(t(unlist(res)), stringsAsFactors = FALSE) + } + } } else { - res <- jsonp_to_json(httr::content(res, as = "text", encoding = "UTF8")) - res <- jsonlite::fromJSON(res) - res_list[[i]] <- as.data.frame(t(unlist(res)), stringsAsFactors = FALSE) + warning("Empty string as query: NA returned.") + res_list[[i]] <- data.frame(address = NA, stringsAsFactors = FALSE) } } - results <- purrr::map_df(res_list, rbind) results[, c("lat", "lng")] <- apply(results[, c("lat", "lng")], 2, as.numeric) From dc3c1b6592f7b2c5d0e3f593ad855f066dfea759 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Carlos=20Vergara-Hern=C3=A1ndez?= Date: Wed, 2 Aug 2017 14:25:27 +0200 Subject: [PATCH 05/11] Add an initial comprobation --- R/cartociudad_reverse_geocode.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/cartociudad_reverse_geocode.R b/R/cartociudad_reverse_geocode.R index c32fb8d..c249f9f 100644 --- a/R/cartociudad_reverse_geocode.R +++ b/R/cartociudad_reverse_geocode.R @@ -35,7 +35,7 @@ #' cartociudad_reverse_geocode <- function(latitude, longitude) { - stopifnot(length(latitude) == length(longitude)) + stopifnot(length(latitude) == length(longitude) | length(latitude) == 0) names_res <- c("type", "tip_via", "address", "portalNumber", "id", "muni", "province", "postalCode", "lat", "lng") From 7a542cefcfc3e1ee2ca82b53df49c2f4c0b2723e Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Carlos=20Vergara-Hern=C3=A1ndez?= Date: Thu, 3 Aug 2017 21:50:26 +0200 Subject: [PATCH 06/11] Change version to 0.5.3 - Remove purrr from Imports: purrr:map_df to plyr::rbind.fill. - Original names in results from cartociudad_reverse_geocode. --- DESCRIPTION | 4 ++-- R/cartociudad_geocode.R | 2 +- R/cartociudad_reverse_geocode.R | 20 ++++++++++++-------- 3 files changed, 15 insertions(+), 11 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 204af03..129269e 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,7 +1,7 @@ Package: caRtociudad Type: Package Title: Interface to Cartociudad API -Version: 0.5.2 +Version: 0.5.3 Date: 2017-07-26 Encoding: UTF-8 Authors@R: c(person("Carlos J.", "Gil Bellosta", email="cgb@datanalytics.com", role=c('cre', 'aut')), @@ -9,7 +9,7 @@ Authors@R: c(person("Carlos J.", "Gil Bellosta", email="cgb@datanalytics.com", r Author: Carlos J. Gil Bellosta, Luz Frías Maintainer: Carlos J. Gil Bellosta Description: Access to Cartociudad cartography API, which provides mapping and other related services for Spain. -Imports: httr, jsonlite, xml2, plyr, geosphere, purrr +Imports: httr, jsonlite, xml2, plyr, geosphere Depends: R (>= 3.0.0) Suggests: ggmap, testthat URL: https://github.com/cjgb/caRtociudad diff --git a/R/cartociudad_geocode.R b/R/cartociudad_geocode.R index 7164144..8a0e74c 100644 --- a/R/cartociudad_geocode.R +++ b/R/cartociudad_geocode.R @@ -73,7 +73,7 @@ cartociudad_geocode <- function(full_address, output_format = "JSON") { res_list[[i]] <- data.frame(address = NA, stringsAsFactors = FALSE) } } - results <- purrr::map_df(res_list, rbind) + results <- plyr::rbind.fill(res_list) results[, c("lat", "lng")] <- apply(results[, c("lat", "lng")], 2, as.numeric) return(results) diff --git a/R/cartociudad_reverse_geocode.R b/R/cartociudad_reverse_geocode.R index c249f9f..c8fe962 100644 --- a/R/cartociudad_reverse_geocode.R +++ b/R/cartociudad_reverse_geocode.R @@ -37,12 +37,10 @@ cartociudad_reverse_geocode <- function(latitude, longitude) { stopifnot(length(latitude) == length(longitude) | length(latitude) == 0) - names_res <- c("type", "tip_via", "address", "portalNumber", "id", - "muni", "province", "postalCode", "lat", "lng") res_list <- list() - - url <- "http://www.cartociudad.es/services/api/geocoder/reverseGeocode" - ua <- get_cartociudad_user_agent() + url <- "http://www.cartociudad.es/services/api/geocoder/reverseGeocode" + ua <- get_cartociudad_user_agent() + no_select <- c("geom", "poblacion", "stateMsg", "state", "priority", "countryCode") for (i in seq_along(latitude)) { query.parms <- list(lat = latitude[i], lon = longitude[i]) @@ -54,11 +52,17 @@ cartociudad_reverse_geocode <- function(latitude, longitude) { stringsAsFactors = FALSE) } else { info <- httr::content(res) - res_list[[i]] <- as.data.frame(t(unlist(info)), - stringsAsFactors = FALSE)[, names_res] + info <- info[-which(names(info) %in% no_select)] + res_list[[i]] <- as.data.frame(t(unlist(info)), stringsAsFactors = FALSE) } } - results <- purrr::map_df(res_list, rbind) + results <- plyr::rbind.fill(res_list) + names_old <- c("type", "tip_via", "address", "portalNumber", "id", + "muni", "province", "postalCode", "lat", "lng") + names_new <- c("tipo", "tipo.via", "nombre.via", "num.via", "num.via.id", + "municipio", "provincia", "cod.postal", "lat", "lng") + colnames(results)[which(colnames(results) %in% names_old)] <- names_new + return(results) } From 11771314b17c2ba24502f322f34f3c80d9ea512b Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Carlos=20Vergara-Hern=C3=A1ndez?= Date: Fri, 4 Aug 2017 10:27:20 +0200 Subject: [PATCH 07/11] New tests & old names to reverse geocoding results --- R/cartociudad_geocode.R | 8 +-- R/cartociudad_reverse_geocode.R | 19 ++++++-- man/cartociudad_geocode.Rd | 8 +-- man/cartociudad_reverse_geocode.Rd | 11 ++++- tests/testthat/test-caRtociudad.R | 78 +++++++++++++++++------------- 5 files changed, 78 insertions(+), 46 deletions(-) diff --git a/R/cartociudad_geocode.R b/R/cartociudad_geocode.R index 8a0e74c..b6c56e4 100644 --- a/R/cartociudad_geocode.R +++ b/R/cartociudad_geocode.R @@ -5,10 +5,10 @@ #' @title Interface to Cartociudad geolocation API #' -#' @description Geolocation of Spanish addresses via Cartociudad API calls, providing the -#' full address in a single text string via \code{full_address}. It is -#' advisable to add the street type (calle, etc.) and to omit the country -#' name. +#' @description Geolocation of Spanish addresses via Cartociudad API calls, +#' providing the full address in a single text string via \code{full_address}. +#' It is advisable to add the street type (calle, etc.) and to omit the +#' country name. #' #' @usage cartociudad_geocode(full_address, output_format = "JSON") #' diff --git a/R/cartociudad_reverse_geocode.R b/R/cartociudad_reverse_geocode.R index c8fe962..b290255 100644 --- a/R/cartociudad_reverse_geocode.R +++ b/R/cartociudad_reverse_geocode.R @@ -16,8 +16,15 @@ #' @param longitude Point longitude in geographical coordinates (e.g., #' -3.7227241) #' -#' @return A data frame consisting of a single row per query. See the reference -#' below for an explanation of the data frame columns. +#' @return A data frame consisting of a single row per query, with columns: +#' \item{tipo}{type of location.} +#' \item{tipo.via}{road type.} +#' \item{nombre.via}{road name.} +#' \item{num.via}{road number.} +#' \item{num.via.id}{internal id of this address in cartociudad database.} +#' \item{municipio}{town.} +#' \item{provincia}{province.} +#' \item{cod.postal}{zip code.} #' #' @author Luz Frias #' @@ -50,6 +57,10 @@ cartociudad_reverse_geocode <- function(latitude, longitude) { warning("Error in query ", i, ": ", httr::http_status(res)$message) res_list[[i]] <- data.frame(lat = latitude[i], lng = longitude[i], stringsAsFactors = FALSE) + } else if (length(httr::content(res)) == 0) { + warning("Query ", i, " produced 0 results.") + res_list[[i]] <- data.frame(lat = latitude[i], lng = longitude[i], + stringsAsFactors = FALSE) } else { info <- httr::content(res) info <- info[-which(names(info) %in% no_select)] @@ -62,7 +73,9 @@ cartociudad_reverse_geocode <- function(latitude, longitude) { "muni", "province", "postalCode", "lat", "lng") names_new <- c("tipo", "tipo.via", "nombre.via", "num.via", "num.via.id", "municipio", "provincia", "cod.postal", "lat", "lng") - colnames(results)[which(colnames(results) %in% names_old)] <- names_new + for (i in seq_len(ncol(results))) { + colnames(results)[colnames(results) == names_old[i]] <- names_new[i] + } return(results) } diff --git a/man/cartociudad_geocode.Rd b/man/cartociudad_geocode.Rd index 52a7dd3..0ed4747 100644 --- a/man/cartociudad_geocode.Rd +++ b/man/cartociudad_geocode.Rd @@ -19,10 +19,10 @@ A data frame consisting of a single row per query. See the reference below for an explanation of the data frame columns. } \description{ -Geolocation of Spanish addresses via Cartociudad API calls, providing the - full address in a single text string via \code{full_address}. It is - advisable to add the street type (calle, etc.) and to omit the country - name. +Geolocation of Spanish addresses via Cartociudad API calls, + providing the full address in a single text string via \code{full_address}. + It is advisable to add the street type (calle, etc.) and to omit the + country name. } \examples{ # Query a single address diff --git a/man/cartociudad_reverse_geocode.Rd b/man/cartociudad_reverse_geocode.Rd index efe905f..982bb9a 100644 --- a/man/cartociudad_reverse_geocode.Rd +++ b/man/cartociudad_reverse_geocode.Rd @@ -13,8 +13,15 @@ cartociudad_reverse_geocode(latitude, longitude) -3.7227241)} } \value{ -A data frame consisting of a single row per query. See the reference - below for an explanation of the data frame columns. +A data frame consisting of a single row per query, with columns: +\item{tipo}{type of location.} +\item{tipo.via}{road type.} +\item{nombre.via}{road name.} +\item{num.via}{road number.} +\item{num.via.id}{internal id of this address in cartociudad database.} +\item{municipio}{town.} +\item{provincia}{province.} +\item{cod.postal}{zip code.} } \description{ Returns the address details of a geographical point in Spain. diff --git a/tests/testthat/test-caRtociudad.R b/tests/testthat/test-caRtociudad.R index 9b707f9..bb9b5bc 100644 --- a/tests/testthat/test-caRtociudad.R +++ b/tests/testthat/test-caRtociudad.R @@ -1,46 +1,58 @@ context("requests") -test_that("cartociudad_geocode returns the location of a full address", { - result <- cartociudad_geocode("plaza de cascorro 11, 28005 madrid") +test_that("cartociudad_geocode & cartociudad_reverse_geocode return valid locations", { + res_geo <- cartociudad_geocode("plaza de cascorro 11, 28005 madrid") + res_inv_geo <- cartociudad_reverse_geocode(res_geo$lat, res_geo$lng) - expect_that(nrow(result) > 0, is_true()) + expect_false(all(sapply(res_geo, is.null))) + expect_false(all(sapply(res_inv_geo, is.null))) + expect_true(nrow(res_geo) > 0) + expect_true(nrow(res_inv_geo) > 0) + + expect_equal(res_geo$state, "1") + expect_equal(res_geo$lat, 40.40988, tolerance = 1e-06) + expect_equal(res_geo$lng, -3.707076, tolerance = 1e-06) + + expect_equal(res_inv_geo$num.via, "11") + expect_equal(res_inv_geo$cod.postal, "28005") + expect_equal(res_inv_geo$municipio, "MADRID") + expect_equal(res_inv_geo$tipo, "portal") + + expect_equal(res_geo$lat, as.numeric(res_inv_geo$lat)) + expect_equal(res_geo$lng, as.numeric(res_inv_geo$lng)) +}) + +test_that("Geocoding and reverse geocoding wrong addresses", { + addresses <- c( + "plaza de cascorro 9000, madrid", + "plaza de cascorro 9001, madrid", + "a7 3000", + "plaza doctor balmis 2, alicante", + "calle inventadisima 1, valencia" + ) + res_geo <- cartociudad_geocode(addresses) + res_inv_geo <- cartociudad_reverse_geocode(res_geo$lat[-5], res_geo$lng[-5]) + + expect_true(nrow(res_geo) == length(addresses)) + expect_true(nrow(res_inv_geo) == length(addresses[-5])) + + expect_equal(res_geo$state, c("2", "3", "4", "5", "10")) + + expect_equal(res_geo$address[1:3], res_inv_geo$nombre.via[1:3]) + + expect_warning(cartociudad_reverse_geocode(res_geo$lat[5], res_geo$lng[5])) }) test_that("get_cartociudadmap returns a map for a valid location", { map <- get_cartociudadmap(c(40.41137, -3.707168), 1) - expect_that(map, is_a("raster")) - expect_that(map, is_a("ggmap")) + expect_is(map, c("raster", "ggmap")) }) test_that("get_cartociudad_location_info returns info for a valid location", { result <- get_cartociudad_location_info(40.473219, -3.7227241) - expect_that(!is.null(result$seccion), is_true()) - expect_that(!is.null(result$distrito), is_true()) - expect_that(!is.null(result$provincia), is_true()) - expect_that(!is.null(result$municipio), is_true()) - expect_that(!is.null(result$ref.catastral), is_true()) - expect_that(!is.null(result$url.ref.catastral), is_true()) - expect_that(!is.null(result$tipo), is_true()) - expect_that(!is.null(result$tipo.via), is_true()) - expect_that(!is.null(result$nombre.via), is_true()) - expect_that(!is.null(result$num.via), is_true()) - expect_that(!is.null(result$num.via.id), is_true()) - expect_that(!is.null(result$cod.postal), is_true()) -}) - -test_that("cartociudad_reverse_geocode returns an address for a valid location", { - result <- cartociudad_reverse_geocode(40.473219, -3.7227241) - - expect_that(!is.null(result$tipo), is_true()) - expect_that(!is.null(result$tipo.via), is_true()) - expect_that(!is.null(result$nombre.via), is_true()) - expect_that(!is.null(result$num.via), is_true()) - expect_that(!is.null(result$num.via.id), is_true()) - expect_that(!is.null(result$municipio), is_true()) - expect_that(!is.null(result$provincia), is_true()) - expect_that(!is.null(result$cod.postal), is_true()) + expect_false(all(sapply(result, is.null))) }) test_that("get_cartociudad_user_agent returns the package name and github repo url", { @@ -49,12 +61,12 @@ test_that("get_cartociudad_user_agent returns the package name and github repo u httr::stop_for_status(result) user.agent <- httr::content(result)$"user-agent" - expect_that(length(grep("caRtociudad/[0-9.]+", user.agent)) == 1, is_true()) - expect_that(length(grep("github.com/cjgb/caRtociudad", user.agent)) == 1, is_true()) + expect_length(grep("caRtociudad/[0-9.]+", user.agent), 1) + expect_length(grep("github.com/cjgb/caRtociudad", user.agent), 1) }) test_that("get_cartociudad_area with valid parameters returns a polygon", { result <- get_cartociudad_area(40.3930144, -3.6596683, 500) - expect_that(nrow(result) > 2, is_true()) + expect_gt(nrow(result), 2) }) From f70df785eebf0009a4fa8e41314333ec5c4debe1 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Carlos=20Vergara-Hern=C3=A1ndez?= Date: Mon, 16 Oct 2017 17:16:58 +0200 Subject: [PATCH 08/11] Update version to 0.5.4 Add progress bar to cartociudad_geocode & cartociudad_reverse_geocode. Add utils to Imports. Add new argument to cartociudad_geocode to use the previous geocoder version and adapt code to it. --- DESCRIPTION | 4 +- R/cartociudad_geocode.R | 75 +++++++++++++++++++++++++-------- R/cartociudad_reverse_geocode.R | 6 ++- man/cartociudad_geocode.Rd | 8 +++- 4 files changed, 71 insertions(+), 22 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 129269e..9c5092e 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,7 +1,7 @@ Package: caRtociudad Type: Package Title: Interface to Cartociudad API -Version: 0.5.3 +Version: 0.5.4 Date: 2017-07-26 Encoding: UTF-8 Authors@R: c(person("Carlos J.", "Gil Bellosta", email="cgb@datanalytics.com", role=c('cre', 'aut')), @@ -9,7 +9,7 @@ Authors@R: c(person("Carlos J.", "Gil Bellosta", email="cgb@datanalytics.com", r Author: Carlos J. Gil Bellosta, Luz Frías Maintainer: Carlos J. Gil Bellosta Description: Access to Cartociudad cartography API, which provides mapping and other related services for Spain. -Imports: httr, jsonlite, xml2, plyr, geosphere +Imports: httr, jsonlite, xml2, plyr, geosphere, utils Depends: R (>= 3.0.0) Suggests: ggmap, testthat URL: https://github.com/cjgb/caRtociudad diff --git a/R/cartociudad_geocode.R b/R/cartociudad_geocode.R index b6c56e4..ef17515 100644 --- a/R/cartociudad_geocode.R +++ b/R/cartociudad_geocode.R @@ -10,13 +10,16 @@ #' It is advisable to add the street type (calle, etc.) and to omit the #' country name. #' -#' @usage cartociudad_geocode(full_address, output_format = "JSON") +#' @usage cartociudad_geocode(full_address, version = c("current", "prev"), +#' output_format = "JSON") #' #' @param full_address Character string providing the full address to be #' geolocated; e.g., "calle miguel servet 5, zaragoza". Adding the country may #' cause problems. #' @param output_format Character string. Output format of the query: "JSON" or -#' "GeoJSON". +#' "GeoJSON". Only applicable if you choose version = "previous". +#' @param version Character string. Geocoder version to use: "current" or +#' "prev". #' #' @return A data frame consisting of a single row per query. See the reference #' below for an explanation of the data frame columns. @@ -39,42 +42,80 @@ #' #' @export #' -cartociudad_geocode <- function(full_address, output_format = "JSON") { +cartociudad_geocode <- function(full_address, version = c("current", "prev"), + output_format = "JSON") { stopifnot(class(full_address) == "character") stopifnot(length(full_address) >= 1) + version <- match.arg(version) no_geocode <- which(nchar(full_address) == 0) - res_list <- list() + total <- length(full_address) + res_list <- list(total) + curr_names <- c("id", "province", "muni", "tip_via", "address", "portalNumber", + "refCatastral", "postalCode", "lat", "lng", "stateMsg", + "state", "type") + prev_names <- c("road_fid", "province", "municipality", "road_type", "road_name", + "numpk_name", "numpk_fid", "zip", "latitude", "longitude", + "comments", "status") + pb <- utils::txtProgressBar(min = 0, max = total, style = 3) + empty_df <- as.data.frame( + matrix(NA_character_, nrow = 0, ncol = length(curr_names), dimnames = list(c(), curr_names)), + stringsAsFactors = FALSE + ) - for (i in seq_along(full_address)) { + for (i in seq_len(total)) { + res_list[[i]] <- empty_df if (!i %in% no_geocode) { - api.args <- list(q = full_address[i], outputformat = output_format) ua <- get_cartociudad_user_agent() - res <- httr::GET("http://www.cartociudad.es/geocoder/api/geocoder/findJsonp", - query = api.args, ua) + if (version == "current") { + api.args <- list(q = full_address[i], outputformat = output_format) + get_url <- "http://www.cartociudad.es/geocoder/api/geocoder/findJsonp" + } else { + api.args <- list(max_results = 1, address = full_address[i]) + get_url <- "http://www.cartociudad.es/CartoGeocoder/Geocode" + } + res <- httr::GET(get_url, query = api.args, ua) if (httr::http_error(res)) { warning("Error in query ", i, ": ", httr::http_status(res)$message) - res_list[[i]] <- data.frame(address = full_address[i], - stringsAsFactors = FALSE) + res_list[[i]] <- plyr::rbind.fill( + res_list[[i]], + data.frame(address = full_address[i], version = version, stringsAsFactors = FALSE) + ) } else { - res <- jsonp_to_json(httr::content(res, as = "text", encoding = "UTF8")) + res <- jsonp_to_json(suppressMessages(httr::content(res, as = "text"))) res <- jsonlite::fromJSON(res) - res <- res[-which(names(res) %in% c("geom", "countryCode", "refCatastral"))] + res <- res[-which(names(res) %in% c("geom", "countryCode", "error", "success"))] + if (version == "current") { + res <- lapply(res, function(x) ifelse(is.null(x), NA_character_, x)) + } else { + res <- res[[1]] + } if (length(res) == 0) { warning("The query has 0 results.") - res_list[[i]] <- data.frame(address = full_address[i], - stringsAsFactors = FALSE) + res_list[[i]] <- plyr::rbind.fill( + res_list[[i]], + data.frame(address = full_address[i], version = version, stringsAsFactors = FALSE) + ) } else { - res_list[[i]] <- as.data.frame(t(unlist(res)), stringsAsFactors = FALSE) + if (version == "current") { + res_list[[i]] <- as.data.frame(t(unlist(res)), stringsAsFactors = FALSE)[, curr_names] + res_list[[i]] <- cbind(res_list[[i]], version = "current") + } else { + res_list[[i]] <- cbind(res[, prev_names], type = NA_character_, version = "prev") + names(res_list[[i]]) <- c(curr_names, "version") + row.names(res_list[[i]]) <- NULL + } } } } else { warning("Empty string as query: NA returned.") - res_list[[i]] <- data.frame(address = NA, stringsAsFactors = FALSE) + res_list[[i]] <- empty_df[1, ] } + utils::setTxtProgressBar(pb, i) } + + cat("\n") results <- plyr::rbind.fill(res_list) results[, c("lat", "lng")] <- apply(results[, c("lat", "lng")], 2, as.numeric) - return(results) } diff --git a/R/cartociudad_reverse_geocode.R b/R/cartociudad_reverse_geocode.R index b290255..00540fc 100644 --- a/R/cartociudad_reverse_geocode.R +++ b/R/cartociudad_reverse_geocode.R @@ -48,8 +48,10 @@ cartociudad_reverse_geocode <- function(latitude, longitude) { url <- "http://www.cartociudad.es/services/api/geocoder/reverseGeocode" ua <- get_cartociudad_user_agent() no_select <- c("geom", "poblacion", "stateMsg", "state", "priority", "countryCode") + total <- length(latitude) + pb <- utils::txtProgressBar(min = 0, max = total, style = 3) - for (i in seq_along(latitude)) { + for (i in seq_len(total)) { query.parms <- list(lat = latitude[i], lon = longitude[i]) res <- httr::GET(url, query = query.parms, ua) @@ -66,8 +68,10 @@ cartociudad_reverse_geocode <- function(latitude, longitude) { info <- info[-which(names(info) %in% no_select)] res_list[[i]] <- as.data.frame(t(unlist(info)), stringsAsFactors = FALSE) } + utils::setTxtProgressBar(pb, i) } + cat("\n") results <- plyr::rbind.fill(res_list) names_old <- c("type", "tip_via", "address", "portalNumber", "id", "muni", "province", "postalCode", "lat", "lng") diff --git a/man/cartociudad_geocode.Rd b/man/cartociudad_geocode.Rd index 0ed4747..eead1ee 100644 --- a/man/cartociudad_geocode.Rd +++ b/man/cartociudad_geocode.Rd @@ -4,7 +4,8 @@ \alias{cartociudad_geocode} \title{Interface to Cartociudad geolocation API} \usage{ -cartociudad_geocode(full_address, output_format = "JSON") +cartociudad_geocode(full_address, output_format = "JSON", version = + c("current", "prev")) } \arguments{ \item{full_address}{Character string providing the full address to be @@ -12,7 +13,10 @@ geolocated; e.g., "calle miguel servet 5, zaragoza". Adding the country may cause problems.} \item{output_format}{Character string. Output format of the query: "JSON" or -"GeoJSON".} +"GeoJSON". Only applicable if you choose version = "previous".} + +\item{version}{Character string. Geocoder version to use: "current" or +"prev".} } \value{ A data frame consisting of a single row per query. See the reference From 5663efaef9fb33ead747708b77afeea1d6339460 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Carlos=20Vergara-Hern=C3=A1ndez?= Date: Mon, 13 Nov 2017 11:17:49 +0100 Subject: [PATCH 09/11] Server error handling --- R/cartociudad_geocode.R | 19 +++++++++++++------ man/cartociudad_geocode.Rd | 17 +++++++++++------ tests/testthat/test-caRtociudad.R | 7 +++++++ 3 files changed, 31 insertions(+), 12 deletions(-) diff --git a/R/cartociudad_geocode.R b/R/cartociudad_geocode.R index ef17515..72d2d9d 100644 --- a/R/cartociudad_geocode.R +++ b/R/cartociudad_geocode.R @@ -11,15 +11,19 @@ #' country name. #' #' @usage cartociudad_geocode(full_address, version = c("current", "prev"), -#' output_format = "JSON") +#' output_format = "JSON", on_error = c("warn", "fail")) #' #' @param full_address Character string providing the full address to be #' geolocated; e.g., "calle miguel servet 5, zaragoza". Adding the country may #' cause problems. -#' @param output_format Character string. Output format of the query: "JSON" or -#' "GeoJSON". Only applicable if you choose version = "previous". -#' @param version Character string. Geocoder version to use: "current" or -#' "prev". +#' @param version Character string. Geocoder version to use: \code{current} or +#' \code{prev}. +#' @param output_format Character string. Output format of the query: +#' \code{JSON} or \code{GeoJSON}. Only applicable if you choose version = +#' "previous". +#' @param on_error Character string. Defaults to \code{warn}: in case of errors, +#' the function will return an empty \code{data.frame} and a warning. Set it +#' to \code{fail} to stop the function call in case of errors in the API call. #' #' @return A data frame consisting of a single row per query. See the reference #' below for an explanation of the data frame columns. @@ -43,11 +47,12 @@ #' @export #' cartociudad_geocode <- function(full_address, version = c("current", "prev"), - output_format = "JSON") { + output_format = "JSON", on_error = c("warn", "fail")) { stopifnot(class(full_address) == "character") stopifnot(length(full_address) >= 1) version <- match.arg(version) + on_error <- match.arg(on_error) no_geocode <- which(nchar(full_address) == 0) total <- length(full_address) res_list <- list(total) @@ -76,6 +81,8 @@ cartociudad_geocode <- function(full_address, version = c("current", "prev"), } res <- httr::GET(get_url, query = api.args, ua) if (httr::http_error(res)) { + if (on_error == "fail") + stop("Call to cartociudad API failed with error code ", res$status_code) warning("Error in query ", i, ": ", httr::http_status(res)$message) res_list[[i]] <- plyr::rbind.fill( res_list[[i]], diff --git a/man/cartociudad_geocode.Rd b/man/cartociudad_geocode.Rd index eead1ee..82192b0 100644 --- a/man/cartociudad_geocode.Rd +++ b/man/cartociudad_geocode.Rd @@ -4,19 +4,24 @@ \alias{cartociudad_geocode} \title{Interface to Cartociudad geolocation API} \usage{ -cartociudad_geocode(full_address, output_format = "JSON", version = - c("current", "prev")) +cartociudad_geocode(full_address, version = c("current", "prev"), + output_format = "JSON", on_error = c("warn", "fail")) } \arguments{ \item{full_address}{Character string providing the full address to be geolocated; e.g., "calle miguel servet 5, zaragoza". Adding the country may cause problems.} -\item{output_format}{Character string. Output format of the query: "JSON" or -"GeoJSON". Only applicable if you choose version = "previous".} +\item{version}{Character string. Geocoder version to use: \code{current} or +\code{prev}.} -\item{version}{Character string. Geocoder version to use: "current" or -"prev".} +\item{output_format}{Character string. Output format of the query: +\code{JSON} or \code{GeoJSON}. Only applicable if you choose version = +"previous".} + +\item{on_error}{Character string. Defaults to \code{warn}: in case of errors, +the function will return an empty \code{data.frame} and a warning. Set it +to \code{fail} to stop the function call in case of errors in the API call.} } \value{ A data frame consisting of a single row per query. See the reference diff --git a/tests/testthat/test-caRtociudad.R b/tests/testthat/test-caRtociudad.R index bb9b5bc..483c6dd 100644 --- a/tests/testthat/test-caRtociudad.R +++ b/tests/testthat/test-caRtociudad.R @@ -43,6 +43,13 @@ test_that("Geocoding and reverse geocoding wrong addresses", { expect_warning(cartociudad_reverse_geocode(res_geo$lat[5], res_geo$lng[5])) }) +test_that("Server error handling", { + address <- c("calle hondon de las nieves 5, alicante") + expect_warning(cartociudad_geocode(address, on_error = "warn")) + expect_error(cartociudad_geocode(address, on_error = "fail")) +}) + + test_that("get_cartociudadmap returns a map for a valid location", { map <- get_cartociudadmap(c(40.41137, -3.707168), 1) From 88685a52938737922f8285a9b8c65fd1d8a9a77d Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Carlos=20Vergara-Hern=C3=A1ndez?= Date: Fri, 24 Nov 2017 17:22:24 +0100 Subject: [PATCH 10/11] Fix "server connection" bug in geocoding functions --- DESCRIPTION | 2 +- R/cartociudad_geocode.R | 14 +++++++++----- R/cartociudad_reverse_geocode.R | 9 +++++---- R/utils.R | 15 +++++++++++++++ man/cartociudad_geocode.Rd | 13 +++++-------- man/cartociudad_reverse_geocode.Rd | 5 ++++- 6 files changed, 39 insertions(+), 19 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 9c5092e..b1a2464 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,7 +1,7 @@ Package: caRtociudad Type: Package Title: Interface to Cartociudad API -Version: 0.5.4 +Version: 0.5.5 Date: 2017-07-26 Encoding: UTF-8 Authors@R: c(person("Carlos J.", "Gil Bellosta", email="cgb@datanalytics.com", role=c('cre', 'aut')), diff --git a/R/cartociudad_geocode.R b/R/cartociudad_geocode.R index 72d2d9d..b9c8222 100644 --- a/R/cartociudad_geocode.R +++ b/R/cartociudad_geocode.R @@ -11,7 +11,7 @@ #' country name. #' #' @usage cartociudad_geocode(full_address, version = c("current", "prev"), -#' output_format = "JSON", on_error = c("warn", "fail")) +#' output_format = "JSON", on_error = c("warn", "fail"), ntries = 10) #' #' @param full_address Character string providing the full address to be #' geolocated; e.g., "calle miguel servet 5, zaragoza". Adding the country may @@ -20,10 +20,12 @@ #' \code{prev}. #' @param output_format Character string. Output format of the query: #' \code{JSON} or \code{GeoJSON}. Only applicable if you choose version = -#' "previous". +#' "current". #' @param on_error Character string. Defaults to \code{warn}: in case of errors, #' the function will return an empty \code{data.frame} and a warning. Set it #' to \code{fail} to stop the function call in case of errors in the API call. +#' @param ntries Numeric. In case of connection failure, number of \code{GET} +#' requests to be made before stopping the function call. #' #' @return A data frame consisting of a single row per query. See the reference #' below for an explanation of the data frame columns. @@ -47,7 +49,8 @@ #' @export #' cartociudad_geocode <- function(full_address, version = c("current", "prev"), - output_format = "JSON", on_error = c("warn", "fail")) { + output_format = "JSON", on_error = c("warn", "fail"), + ntries = 1) { stopifnot(class(full_address) == "character") stopifnot(length(full_address) >= 1) @@ -55,7 +58,7 @@ cartociudad_geocode <- function(full_address, version = c("current", "prev"), on_error <- match.arg(on_error) no_geocode <- which(nchar(full_address) == 0) total <- length(full_address) - res_list <- list(total) + res_list <- vector("list", total) curr_names <- c("id", "province", "muni", "tip_via", "address", "portalNumber", "refCatastral", "postalCode", "lat", "lng", "stateMsg", "state", "type") @@ -79,7 +82,8 @@ cartociudad_geocode <- function(full_address, version = c("current", "prev"), api.args <- list(max_results = 1, address = full_address[i]) get_url <- "http://www.cartociudad.es/CartoGeocoder/Geocode" } - res <- httr::GET(get_url, query = api.args, ua) + res <- get_ntries(get_url, api.args, ua, ntries) + if (httr::http_error(res)) { if (on_error == "fail") stop("Call to cartociudad API failed with error code ", res$status_code) diff --git a/R/cartociudad_reverse_geocode.R b/R/cartociudad_reverse_geocode.R index 00540fc..ab13bcf 100644 --- a/R/cartociudad_reverse_geocode.R +++ b/R/cartociudad_reverse_geocode.R @@ -10,11 +10,13 @@ #' @details This function performs reverse geocoding of a location. It returns #' the details of the closest address in Spain. #' -#' @usage cartociudad_reverse_geocode(latitude, longitude) +#' @usage cartociudad_reverse_geocode(latitude, longitude, ntries = 10) #' #' @param latitude Point latitude in geographical coordinates (e.g., 40.473219) #' @param longitude Point longitude in geographical coordinates (e.g., #' -3.7227241) +#' @param ntries Numeric. In case of connection failure, number of \code{GET} +#' requests to be made before stopping the function call. #' #' @return A data frame consisting of a single row per query, with columns: #' \item{tipo}{type of location.} @@ -40,7 +42,7 @@ #' #' @export #' -cartociudad_reverse_geocode <- function(latitude, longitude) { +cartociudad_reverse_geocode <- function(latitude, longitude, ntries = 1) { stopifnot(length(latitude) == length(longitude) | length(latitude) == 0) @@ -53,8 +55,7 @@ cartociudad_reverse_geocode <- function(latitude, longitude) { for (i in seq_len(total)) { query.parms <- list(lat = latitude[i], lon = longitude[i]) - res <- httr::GET(url, query = query.parms, ua) - + res <- get_ntries(url, query.parms, ua, ntries) if (httr::http_error(res)) { warning("Error in query ", i, ": ", httr::http_status(res)$message) res_list[[i]] <- data.frame(lat = latitude[i], lng = longitude[i], diff --git a/R/utils.R b/R/utils.R index faabd70..9c1508b 100644 --- a/R/utils.R +++ b/R/utils.R @@ -14,3 +14,18 @@ jsonp_to_json <- function(text) { text <- gsub("\\)$", "", text) return(text) } + +get_ntries <- function(url, query, ua, tries) { + withRestarts( + tryCatch(httr::GET(url, query = query, ua), + error = function(e) {invokeRestart("retry")}), + retry = function() { + message("Failing to connect with server: retrying...") + if (tries < 0) { + stop("Failing to connect with server: connection timed out, try later.") + } + Sys.sleep(5) + get_ntries(url, query, ua, tries - 1) + } + ) +} diff --git a/man/cartociudad_geocode.Rd b/man/cartociudad_geocode.Rd index 0301b7f..343ac24 100644 --- a/man/cartociudad_geocode.Rd +++ b/man/cartociudad_geocode.Rd @@ -5,7 +5,7 @@ \title{Interface to Cartociudad geolocation API} \usage{ cartociudad_geocode(full_address, version = c("current", "prev"), - output_format = "JSON", on_error = c("warn", "fail")) + output_format = "JSON", on_error = c("warn", "fail"), ntries = 10) } \arguments{ \item{full_address}{Character string providing the full address to be @@ -17,11 +17,14 @@ cause problems.} \item{output_format}{Character string. Output format of the query: \code{JSON} or \code{GeoJSON}. Only applicable if you choose version = -"previous".} +"current".} \item{on_error}{Character string. Defaults to \code{warn}: in case of errors, the function will return an empty \code{data.frame} and a warning. Set it to \code{fail} to stop the function call in case of errors in the API call.} + +\item{ntries}{Numeric. In case of connection failure, number of \code{GET} +requests to be made before stopping the function call.} } \value{ A data frame consisting of a single row per query. See the reference @@ -33,11 +36,6 @@ Geolocation of Spanish addresses via Cartociudad API calls, It is advisable to add the street type (calle, etc.) and to omit the country name. } -\details{ -The entity geolocation API admits more parameters beyond the address field such as \code{id} or \code{type}. - You can use these extra arguments (see the References or the Examples sections below for further information) - at your own risk. -} \examples{ # Query a single address address <- "plaza de cascorro 11, 28005 madrid" @@ -49,7 +47,6 @@ address <- c(address, "plaza del ayunamiento 1, valencia") my.address <- cartociudad_geocode(full_address = address) print(my.address) -} } \references{ \url{http://www.cartociudad.es/recursos/Documentacion_tecnica/CARTOCIUDAD_ServiciosWeb.pdf} diff --git a/man/cartociudad_reverse_geocode.Rd b/man/cartociudad_reverse_geocode.Rd index 982bb9a..f7458ae 100644 --- a/man/cartociudad_reverse_geocode.Rd +++ b/man/cartociudad_reverse_geocode.Rd @@ -4,13 +4,16 @@ \alias{cartociudad_reverse_geocode} \title{Reverse geocoding of locations} \usage{ -cartociudad_reverse_geocode(latitude, longitude) +cartociudad_reverse_geocode(latitude, longitude, ntries = 10) } \arguments{ \item{latitude}{Point latitude in geographical coordinates (e.g., 40.473219)} \item{longitude}{Point longitude in geographical coordinates (e.g., -3.7227241)} + +\item{ntries}{Numeric. In case of connection failure, number of \code{GET} +requests to be made before stopping the function call.} } \value{ A data frame consisting of a single row per query, with columns: From 07e81e6c09ecaa75fba40e664ac0a7592c2a0eba Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Carlos=20Vergara-Hern=C3=A1ndez?= Date: Fri, 24 Nov 2017 17:22:24 +0100 Subject: [PATCH 11/11] Fix "server connection" bug in geocoding functions --- DESCRIPTION | 2 +- R/cartociudad_geocode.R | 30 ++++++++++++++++++++++-------- R/cartociudad_reverse_geocode.R | 9 +++++---- R/utils.R | 15 +++++++++++++++ man/cartociudad_geocode.Rd | 13 +++++-------- man/cartociudad_reverse_geocode.Rd | 5 ++++- 6 files changed, 52 insertions(+), 22 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 9c5092e..b1a2464 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,7 +1,7 @@ Package: caRtociudad Type: Package Title: Interface to Cartociudad API -Version: 0.5.4 +Version: 0.5.5 Date: 2017-07-26 Encoding: UTF-8 Authors@R: c(person("Carlos J.", "Gil Bellosta", email="cgb@datanalytics.com", role=c('cre', 'aut')), diff --git a/R/cartociudad_geocode.R b/R/cartociudad_geocode.R index 72d2d9d..d63b1d3 100644 --- a/R/cartociudad_geocode.R +++ b/R/cartociudad_geocode.R @@ -11,7 +11,7 @@ #' country name. #' #' @usage cartociudad_geocode(full_address, version = c("current", "prev"), -#' output_format = "JSON", on_error = c("warn", "fail")) +#' output_format = "JSON", on_error = c("warn", "fail"), ntries = 10) #' #' @param full_address Character string providing the full address to be #' geolocated; e.g., "calle miguel servet 5, zaragoza". Adding the country may @@ -20,10 +20,12 @@ #' \code{prev}. #' @param output_format Character string. Output format of the query: #' \code{JSON} or \code{GeoJSON}. Only applicable if you choose version = -#' "previous". +#' "current". #' @param on_error Character string. Defaults to \code{warn}: in case of errors, #' the function will return an empty \code{data.frame} and a warning. Set it #' to \code{fail} to stop the function call in case of errors in the API call. +#' @param ntries Numeric. In case of connection failure, number of \code{GET} +#' requests to be made before stopping the function call. #' #' @return A data frame consisting of a single row per query. See the reference #' below for an explanation of the data frame columns. @@ -47,7 +49,8 @@ #' @export #' cartociudad_geocode <- function(full_address, version = c("current", "prev"), - output_format = "JSON", on_error = c("warn", "fail")) { + output_format = "JSON", on_error = c("warn", "fail"), + ntries = 1) { stopifnot(class(full_address) == "character") stopifnot(length(full_address) >= 1) @@ -55,7 +58,7 @@ cartociudad_geocode <- function(full_address, version = c("current", "prev"), on_error <- match.arg(on_error) no_geocode <- which(nchar(full_address) == 0) total <- length(full_address) - res_list <- list(total) + res_list <- vector("list", total) curr_names <- c("id", "province", "muni", "tip_via", "address", "portalNumber", "refCatastral", "postalCode", "lat", "lng", "stateMsg", "state", "type") @@ -67,6 +70,7 @@ cartociudad_geocode <- function(full_address, version = c("current", "prev"), matrix(NA_character_, nrow = 0, ncol = length(curr_names), dimnames = list(c(), curr_names)), stringsAsFactors = FALSE ) + con_out <- numeric() for (i in seq_len(total)) { res_list[[i]] <- empty_df @@ -79,8 +83,17 @@ cartociudad_geocode <- function(full_address, version = c("current", "prev"), api.args <- list(max_results = 1, address = full_address[i]) get_url <- "http://www.cartociudad.es/CartoGeocoder/Geocode" } - res <- httr::GET(get_url, query = api.args, ua) - if (httr::http_error(res)) { + res <- get_ntries(get_url, api.args, ua, ntries) + + if (length(res) == 0) { + warning("Failing to connect with server in query ", i, + ": try later with addressess in attr(results, 'rerun').") + res_list[[i]] <- plyr::rbind.fill( + res_list[[i]], + data.frame(address = full_address[i], version = version, stringsAsFactors = FALSE) + ) + con_out <- c(con_out, i) + } else if (httr::http_error(res)) { if (on_error == "fail") stop("Call to cartociudad API failed with error code ", res$status_code) warning("Error in query ", i, ": ", httr::http_status(res)$message) @@ -98,7 +111,7 @@ cartociudad_geocode <- function(full_address, version = c("current", "prev"), res <- res[[1]] } if (length(res) == 0) { - warning("The query has 0 results.") + warning("The query ", i, " has 0 results.") res_list[[i]] <- plyr::rbind.fill( res_list[[i]], data.frame(address = full_address[i], version = version, stringsAsFactors = FALSE) @@ -115,7 +128,7 @@ cartociudad_geocode <- function(full_address, version = c("current", "prev"), } } } else { - warning("Empty string as query: NA returned.") + warning("Empty string as query in address ", i, ": NA returned.") res_list[[i]] <- empty_df[1, ] } utils::setTxtProgressBar(pb, i) @@ -124,5 +137,6 @@ cartociudad_geocode <- function(full_address, version = c("current", "prev"), cat("\n") results <- plyr::rbind.fill(res_list) results[, c("lat", "lng")] <- apply(results[, c("lat", "lng")], 2, as.numeric) + attributes(results)$rerun <- full_address[con_out] return(results) } diff --git a/R/cartociudad_reverse_geocode.R b/R/cartociudad_reverse_geocode.R index 00540fc..ab13bcf 100644 --- a/R/cartociudad_reverse_geocode.R +++ b/R/cartociudad_reverse_geocode.R @@ -10,11 +10,13 @@ #' @details This function performs reverse geocoding of a location. It returns #' the details of the closest address in Spain. #' -#' @usage cartociudad_reverse_geocode(latitude, longitude) +#' @usage cartociudad_reverse_geocode(latitude, longitude, ntries = 10) #' #' @param latitude Point latitude in geographical coordinates (e.g., 40.473219) #' @param longitude Point longitude in geographical coordinates (e.g., #' -3.7227241) +#' @param ntries Numeric. In case of connection failure, number of \code{GET} +#' requests to be made before stopping the function call. #' #' @return A data frame consisting of a single row per query, with columns: #' \item{tipo}{type of location.} @@ -40,7 +42,7 @@ #' #' @export #' -cartociudad_reverse_geocode <- function(latitude, longitude) { +cartociudad_reverse_geocode <- function(latitude, longitude, ntries = 1) { stopifnot(length(latitude) == length(longitude) | length(latitude) == 0) @@ -53,8 +55,7 @@ cartociudad_reverse_geocode <- function(latitude, longitude) { for (i in seq_len(total)) { query.parms <- list(lat = latitude[i], lon = longitude[i]) - res <- httr::GET(url, query = query.parms, ua) - + res <- get_ntries(url, query.parms, ua, ntries) if (httr::http_error(res)) { warning("Error in query ", i, ": ", httr::http_status(res)$message) res_list[[i]] <- data.frame(lat = latitude[i], lng = longitude[i], diff --git a/R/utils.R b/R/utils.R index faabd70..8e637fd 100644 --- a/R/utils.R +++ b/R/utils.R @@ -14,3 +14,18 @@ jsonp_to_json <- function(text) { text <- gsub("\\)$", "", text) return(text) } + +get_ntries <- function(url, query, ua, tries) { + withRestarts( + tryCatch(httr::GET(url, query = query, ua), + error = function(e) {invokeRestart("retry")}), + retry = function() { + if (tries <= 0) { + return(character()) + } + message("Failing to connect with server: retrying...") + Sys.sleep(5) + get_ntries(url, query, ua, tries - 1) + } + ) +} diff --git a/man/cartociudad_geocode.Rd b/man/cartociudad_geocode.Rd index 0301b7f..343ac24 100644 --- a/man/cartociudad_geocode.Rd +++ b/man/cartociudad_geocode.Rd @@ -5,7 +5,7 @@ \title{Interface to Cartociudad geolocation API} \usage{ cartociudad_geocode(full_address, version = c("current", "prev"), - output_format = "JSON", on_error = c("warn", "fail")) + output_format = "JSON", on_error = c("warn", "fail"), ntries = 10) } \arguments{ \item{full_address}{Character string providing the full address to be @@ -17,11 +17,14 @@ cause problems.} \item{output_format}{Character string. Output format of the query: \code{JSON} or \code{GeoJSON}. Only applicable if you choose version = -"previous".} +"current".} \item{on_error}{Character string. Defaults to \code{warn}: in case of errors, the function will return an empty \code{data.frame} and a warning. Set it to \code{fail} to stop the function call in case of errors in the API call.} + +\item{ntries}{Numeric. In case of connection failure, number of \code{GET} +requests to be made before stopping the function call.} } \value{ A data frame consisting of a single row per query. See the reference @@ -33,11 +36,6 @@ Geolocation of Spanish addresses via Cartociudad API calls, It is advisable to add the street type (calle, etc.) and to omit the country name. } -\details{ -The entity geolocation API admits more parameters beyond the address field such as \code{id} or \code{type}. - You can use these extra arguments (see the References or the Examples sections below for further information) - at your own risk. -} \examples{ # Query a single address address <- "plaza de cascorro 11, 28005 madrid" @@ -49,7 +47,6 @@ address <- c(address, "plaza del ayunamiento 1, valencia") my.address <- cartociudad_geocode(full_address = address) print(my.address) -} } \references{ \url{http://www.cartociudad.es/recursos/Documentacion_tecnica/CARTOCIUDAD_ServiciosWeb.pdf} diff --git a/man/cartociudad_reverse_geocode.Rd b/man/cartociudad_reverse_geocode.Rd index 982bb9a..f7458ae 100644 --- a/man/cartociudad_reverse_geocode.Rd +++ b/man/cartociudad_reverse_geocode.Rd @@ -4,13 +4,16 @@ \alias{cartociudad_reverse_geocode} \title{Reverse geocoding of locations} \usage{ -cartociudad_reverse_geocode(latitude, longitude) +cartociudad_reverse_geocode(latitude, longitude, ntries = 10) } \arguments{ \item{latitude}{Point latitude in geographical coordinates (e.g., 40.473219)} \item{longitude}{Point longitude in geographical coordinates (e.g., -3.7227241)} + +\item{ntries}{Numeric. In case of connection failure, number of \code{GET} +requests to be made before stopping the function call.} } \value{ A data frame consisting of a single row per query, with columns: