#' Get a Google Map.
#'
#' \code{get_googlemap} accesses the Google Static Maps API version
#' 2 to download a static map. Note that in most cases by using
#' this function you are agreeing to the Google Maps API Terms of
#' Service at \url{https://developers.google.com/maps/terms}.
#'
#' @param center the center of the map. Either a longitude/latitude
#' numeric vector, a string address (note that the latter uses
#' \code{geocode} with \code{source = "google"}).
#' @param zoom map zoom, an integer from 3 (continent) to 21
#' (building), default value 10 (city)
#' @param size rectangular dimensions of map in pixels - horizontal
#' x vertical - with a max of c(640, 640). this parameter is
#' affected in a multiplicative way by scale.
#' @param scale multiplicative factor for the number of pixels
#' returned possible values are 1, 2, or 4 (e.g. size = c(640,640)
#' and scale = 2 returns an image with 1280x1280 pixels). 4 is
#' reserved for google business users only. scale also affects
#' the size of labels as well.
#' @param format character string providing image format - png,
#' jpeg, and gif formats available in various flavors
#' @param maptype character string providing google map theme.
#' options available are "terrain", "satellite", "roadmap", and
#' "hybrid"
#' @param language character string providing language of map labels
#' (for themes with them) in the format "en-EN". not all
#' languages are supported; for those which aren't the default
#' language is used
#' @param messaging turn messaging on/off
#' @param urlonly return url only
#' @param filename destination file for download (file extension added
#' according to format). Default \code{NULL} means a random
#' \code{\link{tempfile}}.
#' @param color color or black-and-white
#' @param force if the map is on file, should a new map be looked
#' up?
#' @param where where should the file drawer be located (without
#' terminating "/")
#' @param archiving use archived maps. note: by changing to TRUE
#' you agree to the one of the approved uses listed in the Google
#' Maps API Terms of Service :
#' http://developers.google.com/maps/terms.
#' @param ext domain extension (e.g. "com", "co.nz")
#' @param inject character string to add to the url
#' @param region borders to display as a region code specified as a
#' two-character ccTLD ("top-level domain") value, see
#' \url{http://en.wikipedia.org/wiki/List_of_Internet_top-level_domains#Country_code_top-level_domains}
#' @param markers data.frame with first column longitude, second
#' column latitude, for which google markers should be embedded in
#' the map image, or character string to be passed directly to api
#' @param path data.frame (or list of data.frames) with first column
#' longitude, second column latitude, for which a single path
#' should be embedded in the map image, or character string to be
#' passed directly to api
#' @param visible a location as a longitude/latitude numeric vector
#' (or data frame with first column longitude, second latitude) or
#' vector of character string addresses which should be visible in
#' map extent
#' @param style character string to be supplied directly to the api
#' for the style argument or a named vector (see examples). this
#' is a powerful complex specification, see
#' \url{https://developers.google.com/maps/documentation/staticmaps/}
#' @param ... ...
#' @return a ggmap object (a classed raster object with a bounding
#' box attribute)
#' @author David Kahle \email{david.kahle@@gmail.com}
#' @seealso
#' \url{https://developers.google.com/maps/documentation/staticmaps/},
#' \code{\link{ggmap}}, \code{\link{register_google}}
#' @export
#' @examples
#'
#' \dontrun{ # to diminish run check time
#'
#'
#' get_googlemap(urlonly = TRUE)
#' ggmap(get_googlemap())
#'
#'
#' # markers and paths are easy to access
#' d <- function(x=-95.36, y=29.76, n,r,a){
#' round(data.frame(
#' lon = jitter(rep(x,n), amount = a),
#' lat = jitter(rep(y,n), amount = a)
#' ), digits = r)
#' }
#' df <- d(n=50,r=3,a=.3)
#' map <- get_googlemap(markers = df, path = df, scale = 2)
#' ggmap(map)
#' ggmap(map, extent = "device") +
#' geom_point(aes(x = lon, y = lat), data = df, size = 3, colour = "black") +
#' geom_path(aes(x = lon, y = lat), data = df)
#'
#' gc <- geocode("waco, texas", source = "google")
#' center <- as.numeric(gc)
#' ggmap(get_googlemap(center = center, color = "bw", scale = 2), extent = "device")
#'
#' # the scale argument can be seen in the following
#' # (make your graphics device as large as possible)
#' ggmap(get_googlemap(center, scale = 1), extent = "panel") # pixelated
#' ggmap(get_googlemap(center, scale = 2), extent = "panel") # fine
#'
#' # archiving; note that you must meet google's terms for this condition
#' map <- get_googlemap(archiving = TRUE)
#' map <- get_googlemap()
#' ggmap(map)
#'
#'
#' # style
#' map <- get_googlemap(
#' maptype = "roadmap",
#' style = c(feature = "all", element = "labels", visibility = "off"),
#' color = "bw"
#' )
#' ggmap(map)
#'
#'
#'
#'
#' }
#'
get_googlemap <- function(
center = c(lon = -95.3632715, lat = 29.7632836), zoom = 10, size = c(640,640),
scale = 2, format = c("png8", "gif", "jpg", "jpg-baseline","png32"),
maptype = c("terrain", "satellite", "roadmap", "hybrid"),
language = "en-EN",
messaging = FALSE, urlonly = FALSE, filename = NULL, color = c("color","bw"),
force = FALSE, where = tempdir(), archiving = FALSE,
ext = "com", inject = "",
region, markers, path, visible, style, ...
){
##### do argument checking
############################################################
args <- as.list(match.call(expand.dots = TRUE)[-1])
argsgiven <- names(args)
# argument checking (no checks for language, region, markers, path, visible, style)
#if(checkargs) get_googlemap_checkargs(args)
if("center" %in% argsgiven){
if(!(
(is.numeric(center) && length(center) == 2) ||
(is.character(center) && length(center) == 1)
)){
stop("center of map misspecified, see ?get_googlemap.", call. = FALSE)
}
if(all(is.numeric(center))){
lon <- center[1]; lat <- center[2]
if(lon < -180 || lon > 180){
stop("longitude of center must be between -180 and 180 degrees.",
" note ggmap uses lon/lat, not lat/lon.", call. = FALSE)
}
if(lat < -90 || lat > 90){
stop("latitude of center must be between -90 and 90 degrees.",
" note ggmap uses lon/lat, not lat/lon.", call. = FALSE)
}
}
}
if("zoom" %in% argsgiven){
if(!(is.numeric(zoom) && zoom == round(zoom) && zoom > 0)){
stop("zoom must be a whole number between 1 and 21", call. = FALSE)
}
}
if("size" %in% argsgiven){
stopifnot(all(is.numeric(size)) && all(size == round(size)) && all(size > 0))
}
if("scale" %in% argsgiven) stopifnot(scale %in% c(1,2,4))
# format arg checked by match.arg
format <- match.arg(format)
if(format != "png8") stop("currently only the png format is supported.", call. = FALSE)
format0 <- sub("[[:digit:]]+|-.*", "", format)
# maptype arg checked by match.arg
maptype <- match.arg(maptype)
if("markers" %in% argsgiven){
markers_stop <- TRUE
if(is.data.frame(markers) && all(apply(markers[,1:2],2,is.numeric))) markers_stop <- FALSE
if(
class(markers) == "list" &&
all(sapply(markers, function(elem){
is.data.frame(elem) && all(apply(elem[,1:2],2,is.numeric))
}))
) markers_stop <- FALSE
if(is.character(markers) && length(markers) == 1) markers_stop <- FALSE
if(markers_stop) stop("improper marker specification, see ?get_googlemap.", call. = FALSE)
}
if("path" %in% argsgiven){
path_stop <- TRUE
if(is.data.frame(path) && all(apply(path[,1:2],2,is.numeric))) path_stop <- FALSE
if(
class(path) == "list" &&
all(sapply(path, function(elem){
is.data.frame(elem) && all(apply(elem[,1:2],2,is.numeric))
}))
) path_stop <- FALSE
if(is.character(path) && length(path) == 1) path_stop <- FALSE
if(path_stop) stop("improper path specification, see ?get_googlemap.", call. = FALSE)
}
if("visible" %in% argsgiven){
message("visible argument untested.")
visible_stop <- TRUE
if(is.data.frame(visible) && all(apply(visible[,1:2],2,is.numeric))) visible_stop <- FALSE
if(is.character(visible)) visible_stop <- FALSE
if(visible_stop) stop("improper visible specification, see ?get_googlemap.", call. = FALSE)
}
if("style" %in% argsgiven){
style_stop <- TRUE
if(is.list(style)) style <- unlist(style)
if(is.character(style)){
if(length(style) > 1){
style <- paste(
paste(names(style), style, sep = ":"),
collapse = "|"
)
}
style_stop <- FALSE
}
if(style_stop) stop("improper style specification, see ?get_googlemap.", call. = FALSE)
}
# if( "sensor" %in% argsgiven) stopifnot(is.logical( sensor))
if("messaging" %in% argsgiven) stopifnot(is.logical(messaging))
if( "urlonly" %in% argsgiven) stopifnot(is.logical( urlonly))
if(is.null(filename)){
destfile <- tempfile(fileext = paste(".", format0, sep = ""))
} else{
filename_stop <- TRUE
if(is.character(filename) && length(filename) == 1) filename_stop <- FALSE
if(filename_stop) stop("improper filename specification, see ?get_googlemap.", call. = FALSE)
destfile <- paste(filename, format0, sep = '.')
}
color <- match.arg(color)
if(!missing(markers) && class(markers) == "list") markers <- list_to_dataframe(markers)
if(!missing(path) && is.data.frame(path)) path <- list(path)
##### construct url
############################################################
base_url <- sprintf("https://maps.googleapis.%s/maps/api/staticmap?", ext)
center_url <- if(all(is.numeric(center))){ # lon/lat specification
center <- round(center, digits = 6)
lon <- center[1]; lat <- center[2]
paste0("center=", paste(lat,lon,sep = ","))
} else { # address specification
centerPlus <- gsub(" ", "+", center)
paste0("center=", centerPlus)
}
size_url <- fmteq(size, paste, collapse = "x")
format_url <- if(!missing(format) && format != "png8"){ fmteq(format) } else { "" }
language_url <- if(!missing(language)){ fmteq(language) } else { "" }
region_url <- if(!missing(region)){ fmteq(region) } else { "" }
markers_url <- if(!missing(markers)){
if(is.data.frame(markers)){
markers <- apply(markers, 1, function(v) paste(rev(round(v,6)), collapse = ","))
fmteq(markers, paste, collapse = "|")
} else {
fmteq(markers)
}
} else { "" }
path_url <- if(!missing(path)){
if(is.list(path)){
ps <- vapply(path, function(one_path){
path <- apply(one_path, 1, function(v) paste(rev(round(v,6)), collapse = ","))
fmteq(path, paste, collapse = "|")
}, character(1))
paste(ps, collapse = "&")
} else {
fmteq(path)
}
} else { "" }
visible_url <- if(!missing(visible)){
if(is.data.frame(visible)){
visible <- apply(visible, 1, function(v) paste(rev(round(v,6)), collapse = ","))
fmteq(visible, paste0, collapse = "|")
} else {
fmteq(visible, paste0, collapse = "|")
}
} else { "" }
style_url <- if(!missing(style)){ fmteq(style) } else { "" }
# sensor_url <- fmteq(sensor, function(x) tolower(as.character(x)))
# format url proper
post_url <- paste(center_url, fmteq(zoom), size_url, fmteq(scale),
format_url, fmteq(maptype), language_url, region_url, markers_url,
path_url, visible_url, style_url, # sensor_url, # sensor no longer required
sep = "&")
# add google account stuff
NeedToSign <- FALSE
if (has_goog_client() && has_goog_signature()) {
NeedToSign <- TRUE
client <- goog_client()
post_url <- paste(post_url, fmteq(client), sep = "&")
} else if (has_goog_key()) {
key <- goog_key()
post_url <- paste(post_url, fmteq(key), sep = "&")
}
url <- paste0(base_url, post_url)
url <- gsub("[&]+","&",url) # removes missing arguments
if(substr(url, nchar(url), nchar(url)) == "&"){ # if ends with &
url <- substr(url, 1, nchar(url)-1)
}
# inject any remaining stuff
if(inject != "") url <- paste(url, inject, sep = "&")
url <- URLencode( enc2utf8(url) )
if(urlonly) return(url)
if(nchar(url) > 2048) stop("max url length is 2048 characters.", call. = FALSE)
if (NeedToSign) {
# Sign if we are using google client and digital signature
url <- signurl(url, secret=goog_signature())
}
##### get map
############################################################
# check to see if url is on file
map <- file_drawer_get(url)
if (!is.null(map) && !force) return(map)
# finalize filename
download.file(url, destfile = destfile, quiet = !messaging, mode = "wb")
message(paste0("Source : ", url))
##### read in map and format, add meta data
############################################################
map <- readPNG(destfile)
map <- aperm(map, c(2, 1, 3))
# format file
if(color == "color"){
map <- apply(map, 2, rgb)
} else if(color == "bw"){
mapd <- dim(map)
map <- gray(.30 * map[,,1] + .59 * map[,,2] + .11 * map[,,3])
dim(map) <- mapd[1:2]
}
map <- matrix(map, nrow = scale*size[2], ncol = scale*size[1])
class(map) <- c("ggmap","raster")
# plot(map)
# map spatial info
if(is.character(center)) center <- as.numeric(geocode(center, source = "google"))
ll <- XY2LatLon(
list(lat = center[2], lon = center[1], zoom = zoom),
-size[1]/2 + 0.5,
-size[2]/2 - 0.5
)
ur <- XY2LatLon(
list(lat = center[2], lon = center[1], zoom = zoom),
size[1]/2 + 0.5,
size[2]/2 - 0.5
)
attr(map, "bb") <- data.frame(
ll.lat = ll[1], ll.lon = ll[2],
ur.lat = ur[1], ur.lon = ur[2]
)
# additional map meta-data
attr(map, "source") <- "google"
attr(map, "maptype") <- maptype
attr(map, "zoom") <- zoom
# transpose
out <- map # t(map)
# archive map for future use
if (archiving) file_drawer_set(url, out)
# kick out
out
}
get_googlemap_checkargs <- function(args){
eargs <- lapply(args, eval)
argsgiven <- names(args)
with(eargs,{
# center arg
if("center" %in% argsgiven){
if(!(
(is.numeric(center) && length(center) == 2) ||
(is.character(center) && length(center) == 1)
)){
stop("center of map misspecified, see ?get_googlemap.", call. = FALSE)
}
if(all(is.numeric(center))){
lon <- center[1]; lat <- center[2]
if(lon < -180 || lon > 180){
stop("longitude of center must be between -180 and 180 degrees.",
" note ggmap uses lon/lat, not lat/lon.", call. = FALSE)
}
if(lat < -90 || lat > 90){
stop("latitude of center must be between -90 and 90 degrees.",
" note ggmap uses lon/lat, not lat/lon.", call. = FALSE)
}
}
}
# zoom arg
if("zoom" %in% argsgiven){
if(!(is.numeric(zoom) && zoom == round(zoom) && zoom > 0)){
stop("zoom must be a whole number between 1 and 21", call. = FALSE)
}
}
# size arg
if("size" %in% argsgiven){
stopifnot(all(is.numeric(size)) && all(size == round(size)) && all(size > 0))
}
# scale arg
if("scale" %in% argsgiven) stopifnot(scale %in% c(1,2,4))
# format arg checked by match.arg
# maptype arg checked by match.arg
# markers arg (optional)
if("markers" %in% argsgiven){
markers_stop <- TRUE
if(is.data.frame(markers) && all(apply(markers[,1:2],2,is.numeric))) markers_stop <- FALSE
if(
class(markers) == "list" &&
all(sapply(markers, function(elem){
is.data.frame(elem) && all(apply(elem[,1:2],2,is.numeric))
}))
) markers_stop <- FALSE
if(is.character(markers) && length(markers) == 1) markers_stop <- FALSE
if(markers_stop) stop("improper marker specification, see ?get_googlemap.", call. = FALSE)
}
# path arg (optional)
if("path" %in% argsgiven){
path_stop <- TRUE
if(is.data.frame(path) && all(apply(path[,1:2],2,is.numeric))) path_stop <- FALSE
if(
class(path) == "list" &&
all(sapply(path, function(elem){
is.data.frame(elem) && all(apply(elem[,1:2],2,is.numeric))
}))
) path_stop <- FALSE
if(is.character(path) && length(path) == 1) path_stop <- FALSE
if(path_stop) stop("improper path specification, see ?get_googlemap.", call. = FALSE)
}
# visible arg (optional)
if("visible" %in% argsgiven){
message("visible argument untested.")
visible_stop <- TRUE
if(is.data.frame(visible) && all(apply(visible[,1:2],2,is.numeric))) visible_stop <- FALSE
if(is.character(visible)) visible_stop <- FALSE
if(visible_stop) stop("improper visible specification, see ?get_googlemap.", call. = FALSE)
}
# style arg (optional)
if("style" %in% argsgiven){
message("style argument untested.")
style_stop <- TRUE
if(is.character(style) && length(style) == 1) style_stop <- FALSE
if(style_stop) stop("improper style specification, see ?get_googlemap.", call. = FALSE)
}
# sensor, messaging, urlonly args
# if("sensor" %in% argsgiven) stopifnot(is.logical(sensor))
if("messaging" %in% argsgiven) stopifnot(is.logical(messaging))
if("urlonly" %in% argsgiven) stopifnot(is.logical(urlonly))
# filename arg
if("filename" %in% argsgiven){
filename_stop <- TRUE
if(is.character(filename) && length(filename) == 1) filename_stop <- FALSE
if(filename_stop) stop("improper filename specification, see ?get_googlemap.", call. = FALSE)
}
# color arg checked by match.arg
}) # end with
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.