使用ggplot的ggmap函数将两个映射叠加在一起
我正在使用ggmap在地图上绘制geom：
Lat = 47.617736
Lon = -122.334244
map1 <- get_map(location = c(lon = Lon, lat = Lat), zoom = 12)
map2 <- get.googlemap.with.style(center=c(lon = Lon, lat = Lat), zoom=12, scale = 2, size = c(640, 640), maptype = "roadmap", color = "color", format = "png8", style = Style1)
ggmap(map1) +
geom_point()
使用Google maps api的样式参数，我可以下载第二张地图map2，其中包含同一地区的街道和水景。
Style1 <- paste("visibility:off",
"&style=feature:road|element:geometry.fill|visibility:on|color:0x7f8080",
"&style=feature:water|element:geometry.fill|visibility:on|color:0x41567d", sep="")
map2 <- get.googlemap.with.style(center=c(lon = Lon, lat = Lat), zoom=12, scale = 2, size = c(640, 640), maptype = "roadmap", color = "color", format = "png8", style = Style1)
我希望能够像geom那样将map2分层，如下所示：
ggmap(map1) +
geom_point() +
map2, alpha = 0.5
我们的想法是在geom下面有一个基本地图，然后能够在geom s（点，stat_density，hex_bin等）之上渲染道路和水景。
我看不到将ggmapraster（从get_map）转换为数据框的可行方法，以启用基于geom_map的解决方案。使用inset_raster，我可以在map1和geom之上绘制map2，但似乎没有办法设置alpha级别，以便map2不会不透明地掩盖geom和map1。
我是否错过了一个明显的功能，或者是否有一个简单的解决方案可以在同一个图中分层两个地图？
根据DWin的评论，为了获得map2，我需要修改get_map以便它接受Google的样式参数。这是支持上面获取map2的调用的代码。
get.googlemap.with.style <- 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",
region, markers, path, visible, style, sensor = FALSE, messaging = FALSE,
urlonly = FALSE, filename = "ggmapTemp", color = c("color", "bw"), ...)
{
args <- as.list(match.call(expand.dots = TRUE)[-1])
argsgiven <- names(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. = F)
}
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. = F)
}
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. = F)
}
}
}
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. = F)
}
}
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))
}
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. = F)
}
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. = F)
}
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. = F)
}
if ("style" %in% argsgiven) {
style_stop <- TRUE
if (is.character(style) && length(style) == 1)
style_stop <- FALSE
if (style_stop)
stop("improper style specification, see ?get_googlemap.",
call. = F)
}
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 ("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. = F)
}
if ("checkargs" %in% argsgiven) {
.Deprecated(msg = "checkargs argument deprecated, args are always checked after v2.1.")
}
format <- match.arg(format)
if (format != "png8")
stop("currently only the png format is supported.", call. = F)
maptype <- match.arg(maptype)
color <- match.arg(color)
if (!missing(markers) && class(markers) == "list")
markers <- plyr:::list_to_dataframe(markers)
if (!missing(path) && is.data.frame(path))
path <- list(path)
base_url <- "http://maps.googleapis.com/maps/api/staticmap?"
center_url <- if (all(is.numeric(center))) {
center <- round(center, digits = 6)
lon <- center[1]
lat <- center[2]
paste("center=", paste(lat, lon, sep = ","), sep = "")
}
else {
centerPlus <- gsub(" ", "+", center)
paste("center=", centerPlus, sep = "")
}
zoom_url <- paste("zoom=", zoom, sep = "")
size_url <- paste("size=", paste(size, collapse = "x"), sep = "")
scale_url <- if (!missing(scale)) {
paste("scale=", scale, sep = "")
}
else {
""
}
format_url <- if (!missing(format) && format != "png8") {
paste("format=", format, sep = "")
}
else {
""
}
maptype_url <- paste("maptype=", maptype, sep = "")
language_url <- if (!missing(language)) {
paste("language=", language, sep = "")
}
else {
""
}
region_url <- if (!missing(region)) {
paste("region=", region, sep = "")
}
else {
""
}
markers_url <- if (!missing(markers)) {
if (is.data.frame(markers)) {
paste("markers=", paste(apply(markers, 1, function(v) paste(rev(round(v,
6)), collapse = ",")), collapse = "|"), sep = "")
}
else {
paste("markers=", markers, sep = "")
}
}
else {
""
}
path_url <- if (!missing(path)) {
if (is.list(path)) {
ps <- sapply(path, function(one_path) {
paste("path=", paste(apply(one_path, 1, function(v) paste(rev(round(v,
6)), collapse = ",")), collapse = "|"), sep = "")
})
paste(ps, collapse = "&", sep = "")
}
else {
paste("path=", path, sep = "")
}
}
else {
""
}
visible_url <- if (!missing(visible)) {
if (is.data.frame(visible)) {
paste("visible=", paste(apply(visible, 1, function(v) paste(rev(round(v,
6)), collapse = ",")), collapse = "|"), sep = "")
}
else {
paste("visible=", paste(visible, collapse = "|"),
sep = "")
}
}
else {
""
}
style_url <- if (!missing(style)) {
paste("style=", style, sep = "")
}
else {
""
}
sensor_url <- paste("sensor=", tolower(as.character(sensor)),
sep = "")
post_url <- paste(center_url, zoom_url, size_url, scale_url,
format_url, maptype_url, language_url, region_url, markers_url,
path_url, visible_url, style_url, sensor_url, sep = "&")
url <- paste(base_url, post_url, sep = "")
url <- gsub("[&]+", "&", url)
if (substr(url, nchar(url), nchar(url)) == "&") {
url <- substr(url, 1, nchar(url) - 1)
}
url <- URLencode(url)
if (urlonly)
return(url)
if (nchar(url) > 2048)
stop("max url length is 2048 characters.", call. = FALSE)
destfile <- if (format %in% c("png8", "png32")) {
paste(filename, "png", sep = ".")
}
else if (format %in% c("jpg", "jpg-baseline")) {
paste(filename, "jpg", sep = ".")
}
else {
paste(filename, "gif", sep = ".")
}
download.file(url, destfile = destfile, quiet = !messaging,
mode = "wb")
print(url)
map <- readPNG(destfile)
if (color == "color") {
map <- apply(map, 2, rgb)
}
else if (color == "bw") {
mapd <- dim(map)
map <- gray(0.3 * map[, , 1] + 0.59 * map[, , 2] + 0.11 *
map[, , 3])
dim(map) <- mapd[1:2]
}
class(map) <- c("ggmap", "raster")
if (is.character(center))
center <- as.numeric(geocode(center))
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])
t(map)
}
1 个答案:
答案 0 :(得分：1)
使用ggmap版本2.0 inset_ggmap（）完全解决了原始问题：
ul li:hover > ul { /* I just added ">" so it affect's only next ul. */
display: block;
opacity: 1;
visibility: visible;
}
ul ul li > ul { /* This will fix the position for children uls */
top: 0;
left: 100%;
}
相关问题
最新问题
- 我写了这段代码，但我无法理解我的错误
- 我无法从一个代码实例的列表中删除 None 值，但我可以在另一个实例中。为什么它适用于一个细分市场而不适用于另一个细分市场？
- 是否有可能使 loadstring 不可能等于打印？卢阿
- java中的random.expovariate()
- Appscript 通过会议在 Google 日历中发送电子邮件和创建活动
- 为什么我的 Onclick 箭头功能在 React 中不起作用？
- 在此代码中是否有使用“this”的替代方法？
- 在 SQL Server 和 PostgreSQL 上查询，我如何从第一个表获得第二个表的可视化
- 每千个数字得到
- 更新了城市边界 KML 文件的来源？