Skip to content

Commit

Permalink
stamenJPGFix2
Browse files Browse the repository at this point in the history
  • Loading branch information
@dkahle
dkahle committed Mar 26, 2014
1 parent 1721e6c commit c7c4894
Show file tree
Hide file tree
Showing 3 changed files with 67 additions and 8 deletions.
11 changes: 10 additions & 1 deletion NEWS
View file
Original file line number Diff line number Diff line change
@@ -1,3 +1,12 @@
ggmap 2.4
-------------------------------------------------------------------------

CHANGES

* some stamen maps have moved to jpgs; this has been fixed.



ggmap 2.4
-------------------------------------------------------------------------

Expand All @@ -6,7 +15,7 @@ CHANGES
* ggmap now forms a directory in the working directory which caches queries.
* ggmap is now slightly less verbose: Terms of Service references are moved to package load.
* geocode has been given an overhaul; it now accepts a data argument for data frames (see examples), and no longer errors when it runs out of checks.
* stamen maps now hosts a wide new variety of maptypes that are kin of the existing ones. see ?get_stamenmap. also, as stamen has moved to jpgs, the package jpeg is now imported.
* stamen maps now hosts a wide new variety of maptypes that are kin of the existing ones. see ?get_stamenmap.
* the license is now a GPL-2.


Expand Down
45 changes: 39 additions & 6 deletions R/get_stamenmap.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -35,6 +35,23 @@
#' # ggmap(get_stamenmap(bbox, zoom = 16))
#' # ggmap(get_stamenmap(bbox, zoom = 17))
#'
#'
#' # various maptypes are available. bump it up to zoom = 15 for better resolution.
#' ggmap(get_stamenmap(bbox, maptype = "terrain", zoom = 14))
#' ggmap(get_stamenmap(bbox, maptype = "terrain-background", zoom = 14))
#' ggmap(get_stamenmap(bbox, maptype = "terrain-labels", zoom = 14))
#' ggmap(get_stamenmap(bbox, maptype = "terrain-lines", zoom = 14))
#' ggmap(get_stamenmap(bbox, maptype = "toner", zoom = 14))
#' ggmap(get_stamenmap(bbox, maptype = "toner-2010", zoom = 14))
#' ggmap(get_stamenmap(bbox, maptype = "toner-2011", zoom = 14))
#' ggmap(get_stamenmap(bbox, maptype = "toner-background", zoom = 14))
#' ggmap(get_stamenmap(bbox, maptype = "toner-hybrid", zoom = 14))
#' ggmap(get_stamenmap(bbox, maptype = "toner-labels", zoom = 14))
#' ggmap(get_stamenmap(bbox, maptype = "toner-lines", zoom = 14))
#' ggmap(get_stamenmap(bbox, maptype = "toner-lite", zoom = 14))
#' ggmap(get_stamenmap(bbox, maptype = "watercolor", zoom = 14))
#'
#'
#' ggmap(get_stamenmap(bbox, maptype = "watercolor", zoom = 11), extent = "device")
#' ggmap(get_stamenmap(bbox, maptype = "watercolor", zoom = 12), extent = "device")
#' ggmap(get_stamenmap(bbox, maptype = "watercolor", zoom = 13), extent = "device")
Expand Down Expand Up @@ -79,7 +96,7 @@
#'
get_stamenmap <- function(
bbox = c(left = -95.80204, bottom = 29.38048, right = -94.92313, top = 30.14344),
zoom = 10, maptype = c("terrain","terrain-background","terrain=labels",
zoom = 10, maptype = c("terrain","terrain-background","terrain-labels",
"terrain-lines", "toner", "toner-2010", "toner-2011", "toner-background",
"toner-hybrid", "toner-labels", "toner-lines", "toner-lite", "watercolor"),
crop = TRUE, messaging = FALSE,
Expand Down Expand Up @@ -113,7 +130,13 @@ get_stamenmap <- function(
if("checkargs" %in% argsgiven){
.Deprecated(msg = "checkargs argument deprecated, args are always checked after v2.1.")
}


# set image type (stamen only)
if(maptype %in% c("terrain","terrain-background","watercolor")){
filetype <- "jpg"
} else {
filetype <- "png"
}

# argument checking (no checks for language, region, markers, path, visible, style)
#args <- as.list(match.call(expand.dots = TRUE)[-1])
Expand Down Expand Up @@ -148,7 +171,7 @@ get_stamenmap <- function(
base_url <- paste(base_url, maptype, "/", zoom, sep = "")
urls <- paste(base_url,
apply(tilesNeeded, 1, paste, collapse = "/"), sep = "/")
urls <- paste(urls, ".jpg", sep = "")
urls <- paste(urls, filetype, sep = ".")
if(messaging) message(length(urls), " tiles required.")
if(urlonly) return(urls)
if(any(sapply(as.list(urls), url_lookup) != FALSE)) message("Using archived tiles...")
Expand Down Expand Up @@ -281,18 +304,28 @@ get_stamenmap_tile <- function(maptype, zoom, x, y, force = FALSE, messaging = T
stopifnot(is.wholenumber(y) || !(0 <= y && y < 2^zoom))

# format url http://tile.stamen.com/[maptype]/[zoom]/[x]/[y].jpg
url <- paste0(paste0(c("http://tile.stamen.com", maptype, zoom, x, y), collapse = "/"), ".jpg")
if(maptype %in% c("terrain","terrain-background","watercolor")){
filetype <- "jpg"
} else {
filetype <- "png"
}
url <- paste0(paste0(c("http://tile.stamen.com", maptype, zoom, x, y), collapse = "/"), ".", filetype)

# lookup in archive
lookup <- url_lookup(url)
if(lookup != FALSE && force == FALSE) return(recall_ggmap(url))

# grab if not in archive
download.file(url, destfile = "ggmapFileDrawer/ggmapTemp.jpg", quiet = !messaging, mode = "wb")
download.file(url, destfile = paste0("ggmapFileDrawer/ggmapTemp.", filetype),
quiet = !messaging, mode = "wb")
if(TRUE) message(paste0("Map from URL : ", url))

# read in and format
tile <- readJPEG("ggmapFileDrawer/ggmapTemp.jpg")
if(maptype %in% c("terrain","terrain-background","watercolor")){
tile <- readJPEG("ggmapFileDrawer/ggmapTemp.jpg")
} else {
tile <- readPNG("ggmapFileDrawer/ggmapTemp.png")
}
tile <- t(apply(tile, 2, rgb))

# determine bbox of map. note : not the same as the argument bounding box -
Expand Down
19 changes: 18 additions & 1 deletion man/get_stamenmap.Rd
View file
Original file line number Diff line number Diff line change
Expand Up @@ -4,7 +4,7 @@
\usage{
get_stamenmap(bbox = c(left = -95.80204, bottom = 29.38048, right = -94.92313,
top = 30.14344), zoom = 10, maptype = c("terrain", "terrain-background",
"terrain=labels", "terrain-lines", "toner", "toner-2010", "toner-2011",
"terrain-labels", "terrain-lines", "toner", "toner-2010", "toner-2011",
"toner-background", "toner-hybrid", "toner-labels", "toner-lines",
"toner-lite", "watercolor"), crop = TRUE, messaging = FALSE,
urlonly = FALSE, color = c("color", "bw"), force = FALSE, ...)
Expand Down Expand Up @@ -62,6 +62,23 @@ ggmap(get_stamenmap(bbox, zoom = 15))
# ggmap(get_stamenmap(bbox, zoom = 16))
# ggmap(get_stamenmap(bbox, zoom = 17))
# various maptypes are available. bump it up to zoom = 15 for better resolution.
ggmap(get_stamenmap(bbox, maptype = "terrain", zoom = 14))
ggmap(get_stamenmap(bbox, maptype = "terrain-background", zoom = 14))
ggmap(get_stamenmap(bbox, maptype = "terrain-labels", zoom = 14))
ggmap(get_stamenmap(bbox, maptype = "terrain-lines", zoom = 14))
ggmap(get_stamenmap(bbox, maptype = "toner", zoom = 14))
ggmap(get_stamenmap(bbox, maptype = "toner-2010", zoom = 14))
ggmap(get_stamenmap(bbox, maptype = "toner-2011", zoom = 14))
ggmap(get_stamenmap(bbox, maptype = "toner-background", zoom = 14))
ggmap(get_stamenmap(bbox, maptype = "toner-hybrid", zoom = 14))
ggmap(get_stamenmap(bbox, maptype = "toner-labels", zoom = 14))
ggmap(get_stamenmap(bbox, maptype = "toner-lines", zoom = 14))
ggmap(get_stamenmap(bbox, maptype = "toner-lite", zoom = 14))
ggmap(get_stamenmap(bbox, maptype = "watercolor", zoom = 14))
ggmap(get_stamenmap(bbox, maptype = "watercolor", zoom = 11), extent = "device")
ggmap(get_stamenmap(bbox, maptype = "watercolor", zoom = 12), extent = "device")
ggmap(get_stamenmap(bbox, maptype = "watercolor", zoom = 13), extent = "device")
Expand Down

0 comments on commit c7c4894

Please sign in to comment.