#' ####################################################################
#' #' Get Google's Geodata given the Addresses
#' #'
#' #' This function lets the user obtain Google's Geodata on given addresses
#' #'
#' #' @family Geographical
#' #' @family Credentials
#' #' @family Google
#' #' @param address Character Vector. Addresses you wish to query
#' #' @param country Character. Default Country if known
#' #' @param index Character Vector. If you wish to keep an id on each
#' #' address, set this values
#' #' @param creds Character. Credential's user (see \code{get_creds()})
#' #' @param which Character. Which of the APIs should be used?
#' #' @export
#' geoAddress <- function(address, country = "Argentina", index = NA, creds = NA, which = "api_01") {
#'
#' try_require("rlist")
#'
#' message("API Documentation: https://developers.google.com/maps/documentation/geocoding/usage-and-billing")
#' c <- get_credentials(from = "google_api", dir = creds)
#' message("API Geocoding user: ", as.character(c[grepl(paste0("user_",right(which, 2)), names(c))]))
#'
#' getGeoDetails <- function(address){
#'
#' c <- get_credentials(from = "google_api", dir = creds)
#' url <- "https://maps.google.com/maps/api/geocode/json?address="
#' api <- as.character(c[grepl(which, names(c))]) # api_01 is my personal free API
#' ctry <- paste0("&components=country:", country)
#' url <- URLencode(paste(url, address, ctry, "&key=", api, sep = ""))
#' x <- fromJSON(url, simplifyVector = FALSE)
#'
#' # Return Na's if we didn't get a match:
#' if (x$status != "OK") return(message(paste(x$status, x$error_message)))
#'
#' # Else, extract what we need from the Google server reply into a dataframe:
#'
#' # Note: We bring the first and most probable result or prefered country only
#' if (length(x$results) > 1) {
#' country_pref <- data.frame(
#' is_country = as.integer(as.character(lapply(
#' x$results, function(x) grep(paste(",",country), x)))))
#' country_pref$row <- seq_len(nrow(country_pref))
#' country_pref <- country_pref[!is.na(country_pref$is_country),]
#' which_list <- min(country_pref$row)
#' if (nrow(country_pref) == 0) which_list <- 1
#' } else {
#' which_list <- 1
#' }
#'
#' # Address_components (varies a lot depending on results)
#' values <- data.frame(list.cbind(x$results[[which_list]]$address_components))[1,]
#' names <- unlist(do.call(rbind, list.cbind(x$results[[which_list]]$address_components)[3,])[,1])
#' if (length(colnames(values)) > 1) colnames(values) <- names
#'
#' out <- data.frame(
#' status = x$status,
#' lon = x$results[[which_list]]$geometry$location$lng,
#' lat = x$results[[which_list]]$geometry$location$lat,
#' accuracy = x$results[[which_list]]$types[[1]],
#' address_type = paste(x$results[[which_list]]$types, collapse = ','),
#' address_formatted = x$results[[which_list]]$formatted_address,
#' neighborhood = ifelse("neighborhood" %in% colnames(values),
#' toupper(as.character(values$neighborhood)), NA),
#' postal_code = ifelse("postal_code" %in% colnames(values),
#' as.integer(as.character(values$postal_code)), NA),
#' political = ifelse("political" %in% colnames(values),
#' toupper(as.character(values$political)), NA),
#' country = ifelse("country" %in% colnames(values),
#' toupper(as.character(values$country)), NA))
#' return(out)
#' }
#'
#' output <- NULL
#'
#' for (i in seq_along(address)) {
#' message(paste("Working on address", i, "of", length(address)))
#' result <- getGeoDetails(address[i])
#' if (length(result) > 1) {
#' result$index <- i
#' result$search <- address[i]
#' if (!is.na(index)) result$id <- index[i]
#' output <- rbind(output, result)
#' message(paste("Found:", result$address_formatted))
#' }
#' done <- output
#' }
#' return(done)
#' }
#'
#'
#' ####################################################################
#' #' Get Colombia's Stratum given the Coordinates
#' #'
#' #' This function lets the user obtain Colombia's stratum given the coordinates of an address
#' #'
#' #' @family Geographical
#' #' @family Scrapper
#' #' @param lon Numeric Vector. Longitudes
#' #' @param lat Numeric Vector. Latitudes
#' #' @param label Character Vector. If you wish to keep an id on each address, set this values
#' #' @export
#' geoStratum <- function(lon, lat, label = NA) {
#' # Manzanas: http://serviciosgis.catastrobogota.gov.co/arcgis/rest/services/social/estrato/MapServer?f=jsapi
#' url <- URLencode(paste0(
#' "http://serviciosgis.catastrobogota.gov.co/arcgis/rest/services/social/estrato/MapServer/0/query?",
#' "where=1%3D1&text=&objectIds=&time=&distance=15&",
#' "geometry=%7B%22x%22%3A+", lon, "%2C+%22y%22%3A+", lat,
#' "%7D&geometryType=esriGeometryPoint&inSR=4686&spatialRel=esriSpatialRelIntersects&relationParam=&outFields=ESTRATO&",
#' "returnGeometry=false&returnTrueCurves=false&maxAllowableOffset=&geometryPrecision=&outSR=&returnIdsOnly=false&",
#' "returnCountOnly=false&orderByFields=&groupByFieldsForStatistics=&outStatistics=&returnZ=false&returnM=false&",
#' "gdbVersion=&returnDistinctValues=false&resultOffset=&resultRecordCount=&",
#' "returnExtentsOnly=false&datumTransformation=¶meterValues=&rangeValues=&f=pjson"))
#' x <- fromJSON(url, simplifyVector = FALSE)
#' if (length(x$features) > 0) {
#' out <- data.frame(lon = lon, lat = lat, stratum = x$features[[1]]$attributes$ESTRATO)
#' if (!is.na(label)) out$label <- label
#' return(out)
#' } else {
#' message("Stratum not found for those coordinates!")
#' }
#' }
#'
#'
#' ####################################################################
#' #' Check, Cross, and Plot Coordinates with Polygons
#' #'
#' #' This function checks a series of coordinates and return a join
#' #' with the information of each coordinate and its respective grid.
#' #' Note that the coords and shapes coordinates MUST have the same
#' #' lon/lat reference system for it to work succesfully.
#' #'
#' #' @family Geographical
#' #' @param coords Dataframe. Dataframe containing at least langitud
#' #' and latitud data
#' #' @param map SpatialPolygonsDataFrame or .shp directory
#' #' @param fix_coords Boolean. Transform and fix coordinates system?
#' #' @param plot Boolean. Return plot with coordinates inside the grid?
#' #' @param all Boolean. Include all coordinates in plot, i.e. only the
#' #' ones who are inside the grids?
#' #' @param alpha Numeric. Points transparency for the plot
#' #' @export
#' geoGrid <- function(coords, map, fix_coords = FALSE, plot = FALSE, all = FALSE, alpha = 0.3) {
#'
#' try_require("methods")
#' try_require("rgdal")
#' try_require("sp")
#'
#' if (!class(map)[1] == "SpatialPolygonsDataFrame") {
#' message("Importing shapefile...")
#' map <- readOGR(dsn = file.path(map))
#' }
#'
#' cols <- colnames(coords)
#' if (sum(grepl("lon|lat", tolower(cols))) != 2) {
#' stop("Your coords dataframe must contain longitude and latitude!")
#' }
#' cols[grep("lon",tolower(cols))] <- "longitude"
#' cols[grep("lat",tolower(cols))] <- "latitude"
#' colnames(coords) <- cols
#' coordinates(coords) <- c("longitude", "latitude")
#'
#' if (fix_coords) map <- spTransform(map, CRS("+proj=longlat +datum=WGS84"))
#'
#' shapes_sample <- head(map@polygons[[2]]@Polygons[[1]]@coords)
#' proj4string <- "+proj=utm +units=mm"
#' project(shapes_sample, proj4string)
#'
#' # The coords and shapes coordinates MUST have the same lon/lat reference system
#' proj4string(coords) <- proj4string(map)
#' inside.park <- !is.na(over(coords, as(map, "SpatialPolygons")))
#' #inside.park <- !is.na(over(coords, as.SpatialPolygons.PolygonsList(map)))
#'
#' # What fraction of coords are inside a shape?
#' frac <- round(100*mean(inside.park), 2)
#' fracmsg <- paste0("Fraction of coords inside the grid: ", frac,"%")
#' message(fracmsg)
#' cross <- over(coords, map)
#' crossed <- which(!is.na(cross[,1]))
#'
#' # Join data and return results
#' results <- data.frame(coords, cross)
#'
#' # Plot map and coordinates
#' if (plot) {
#' if (!all) {
#' toplot <- results[crossed,]
#' } else {
#' toplot <- results
#' }
#' plot <- ggplot() +
#' geom_point(data = toplot, aes(x = .data$longitude, y = .data$latitude),
#' colour = "deepskyblue2", alpha = alpha) +
#' geom_polygon(data = map, aes(x = .data$long, y = .data$lat, group = .data$group),
#' colour = "black", fill = "white", alpha = 0) +
#' labs(title = "Coordinates & Grid",
#' subtitle = fracmsg,
#' x = "Longitude", y = "Latitude") +
#' theme_bw()
#' results <- list(results = results, plot = plot)
#' }
#' return(results)
#' }
#'
#'
#' ####################################################################
#' #' Plot Map or Shapefile
#' #'
#' #' This function returns a simple plot from a SpatialPolygonsDataFrame
#' #' imported or a .shp file
#' #'
#' #' @family Geographical
#' #' @param map SpatialPolygonsDataFrame or .shp directory
#' #' @param fix_coords Boolean. Transform and fix coordinates system?
#' #' @param title Character. Title for the plot
#' #' @param subtitle Character. Subtitle for the plot
#' #' @export
#' geoMap <- function(map, fix_coords = FALSE, title = NA, subtitle = NA) {
#'
#' try_require("rgdal")
#' try_require("sp")
#'
#' if (!class(map)[1] == "SpatialPolygonsDataFrame") {
#' message("Importing shapefile...")
#' map <- readOGR(dsn = file.path(map))
#' }
#' if (fix_coords) {
#' message("Fixing coordinates format...")
#' map <- spTransform(map, CRS("+proj=longlat +datum=WGS84"))
#' }
#' plot <- ggplot() +
#' geom_polygon(data = map, aes(x = .data$long, y = .data$lat, group = .data$group),
#' colour = "black", fill = "white", alpha = 0.1) +
#' labs(x = "Latitude", y = "Longitude") +
#' theme_bw()
#'
#' if (!is.na(title)) plot <- plot + labs(title = title)
#' if (!is.na(subtitle)) plot <- plot + labs(subtitle = subtitle)
#'
#' return(plot)
#' }
#'
#'
#' ####################################################################
#' #' Convert from degrees to numeric coordinates [Deprecated]
#' #'
#' #' This function converts degrees (DMS) coordinates into numerical.
#' #' Note that the sign (S or W) should be assigned manually if needed.
#' #'
#' #' @family Calculus
#' #' @param coord Character vector. Coordinate in format c("DD MM SS")
#' #' @param sep Character. Separator
#' #' @examples
#' #' deg2num("11 12 12")
#' #' deg2num("00-00-00", sep = "-")
#' #' @export
#' deg2num <- function(coord, sep = " ") {
#' z <- str_split_fixed(as.character(coord), sep, 3)
#' z <- as.numeric(as.character(unlist(z)))
#' num <- z[1] + z[2]/60 + z[3]/3600
#' return(num)
#' }
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.