使用ggplot的ggmap函数将两个地图叠加在一起 [英] Using ggplot's ggmap function to superimpose two maps on top of each other

问题描述

我使用 ggmap 在地图顶部绘制 geom s：

  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（）
  

使用谷歌地图api的样式参数，我可以下载第二张地图map2，只显示同一地区的街道和水景。

  Style1 < -  paste（visibility：off，
& style = feature：road |元素：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 = 路线图， color =color，format =png8，style = Style1）
  

我想成为能够在 geom 之上层叠map2，如下所示：

  ggmap（map1）+ 
 geom_point（）+ 
 map2，alpha = 0.5 
  

这个想法是在 geom s下面有一个底图，然后能够在 geom 顶部绘制道路和水景。 code> s（points，stat_density，hex_bin等）



我看不到一个可行的方法来转换 ggmapraster

code>> get_map ）添加到数据框中，以启用基于 geom_map 的解决方案。使用 inset_raster ，我可以在map1顶部绘制map2，在 geom 中绘制map2，但似乎没有办法设置 alpha 级别，以便map2不会掩盖 geom s和map1。

我是否错过了一个显而易见的功能，或者是否有一个简单的解决方案来将两张地图分层放置在同一个地块中？ b b
根据迪文的评论，为了得到map2，我需要修改get_map，以便接受Google的样式参数。

  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，
区域，标记，path，visible，style，sensor = FALSE，messaging = FALSE，
 urlonly = FALSE，filename =ggmapTemp，color = c（color，bw），...）
 {
 args<  -  as.list（match.call（expand.dots = TRUE）[ -  1]）$ ​​b $ b argsgiven<  - （args）
 if（center （中心）&长度（中心）== 2）|| 
（is.character（center）&& length（％argsgiven）{
 if（！ （center）== 1）））{
 stop（map 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（中心的经度必须在-180和180度之间。，
注意ggmap使用lon / lat，而不是经纬度。，call。= F）
 
 if（lat <-90 || lat> 90）{
 stop（中心的纬度必须在-90到90度之间。，
note ggmap ，call。= F）
} 
} 
} 
 if（zoom％％in％argsgiven）{$ b $如果（！（is.numeric（zoom）&& zoom == round（zoom）&& zoom> 
 0））{
 stop（zoom必须是整数如果（size％in％argsgiven）{
 stopifnot（all（is。）（
 call）= F）
} 
} 
。 （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（marker），function（elem）{
 is.data.frame（elem）& all（apply（elem [，1：2]，2，
 is.numeric ））
 marker_stop<  -  FALSE 
 if（is.character（markers）&& length（markers）== 1）
 markers_stop< - 假（$ marker）= 
 if ％in％argsgiven）{
 path_stop<  -  TRUE 
 if（is.data.frame（path）&& all（apply（path [，1：2]，2，$ b $ （路径）==list&& all（sapply（路径，函数（elem））{
（））
 path_stop<  -  FALSE 
 if isdata.frame（elem）& all（apply（elem [，1：2]，2，
 is.numeric））
}）））
 path_stop< - 假
 if（is.char acter（路径）&& （路径）== 1）
 path_stop<  -  FALSE 
 if（path_stop）
 stop（不正确的路径规范，请参阅？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（ （可见），
 visible_stop<  -  FALSE 
 if（visible_stop）
 stop（ （样式）％&长度（样式）=样式（样式）％
 
 if（style％in％argsgiven）{
 style_stop<  -  TRUE 
 if = 1）
 style_stop<  -  FALSE 
 if（style_stop）
 stop（不正确的样式规范，请参阅？get_googlemap。，
 call。= F）
 } 
 if（sensor％in％argsgiven）
 stopifnot（is.l ogical（传感器））
 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）&& （文件名）== 1）
 filename_stop<  -  FALSE 
 if（filename_stop）
 stop（不正确的文件名说明，请参阅？get_googlemap。，
 call。= F ）
} 
 if（checkargs％in％argsgiven）{
 .Deprecated（msg =checkargs argument deprecated，args always always checked v2.1 after。）
 
格式<  -  match.arg（格式）
 if（format！=png8）
 stop（当前只支持png格式，call。= F） 
 maptype<  -  match.arg（maptype）
 color<  -  match.arg（color）
 if（！missing（markers）&& class（markers）==列表）
标记< -plyr ::: list_to_dataframe（标记）
 if（！missing（path）&& is.data.frame（path））
 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 {

 $ b b format_url<  -  if（！missing（format）&& format！=png8）{
 paste（format =，format，sep =）
 $ b $ else 
 
 
 maptype_url < -  paste（maptype =，maptype，sep =）
 language_url < - if（！missing（language））{
 paste（language =，language，sep =）
} 
 else {

} 
 region_u rl<  -  if（！missing（region））{
 paste（region =，region，sep =）
} 
 else {

 
 markers_url < -  if（！missing（markers））{
 if（is.data.frame（markers））{
 paste（markers =，paste（apply （marker，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 ！缺失（可见））{
 if（is.data.frame（visible））{
 paste（visible =，paste（apply（visible），1，function（v）paste（rev（round（v， 
 6）），collapse =，）），collapse =|），sep =）
} 
 else {
 paste（visible =，粘贴（可见，折叠=|），
 sep =）
} 
} 
其他{

} 
 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（最大URL长度为2048个字符，call。= FALSE）
 destfile < -  if（格式％in％c（png8，png32））{
 paste（filename，png，sep =。）
} 
 else if（格式％in％c（jpg，jpg-baseline））{
粘贴（文件名，jpg，sep =。）
} 
其他{
粘贴（文件名，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 （中心））
 center < -  as.numeric（geocode（center））
 ll < -  XY2LatLon（list（lat = center [2]，lon = center [1]， zoom = zoom），
 （列表（lat =中心[2]，lon =中心[1]，缩放=缩放））的大小（大小为[1] / 2 + 0.5， - 大小[2] / 2-0.5） ，
 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（地图）
} 
 < code $ <$ pre 
 
解决方案
原始问题使用ggmap version 2.0 inset_ggmap（） p> 
 
 
  require（ggmap）
 
 map.background<  -  get_map（c（lon = -122，lat = 47.5），map =toner-background）
 map.lines<  -  get_map（c（lon = -122，lat = 47.5），map =toner-lines）
 map。标签< -get_map（c（lon = -122，lat = 47.5），map =碳粉标签）
 
 set.seed（127）
 df<  - 数据。 （lon = rnorm（25，mean = -122.2，sd = 0.2），
 lat = rnorm（25，mean = 47.5，sd = 0.1），
 size = rnorm（25，mean = 15 ，sd = 5））
 
 ggmap（map.background）+ 
 geom_point （data = df，
 aes（x = lon，y = lat，size = size），
 color =blue，alpha = 0.8）+ 
 scale_size_identity（guide =none ）+ 
 inset_ggmap（map.lines）+ 
 inset_ggmap（map.labels）
  
  
 
I am using ggmap to plot geoms on top of a map:
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()
Using style parameters for the Google maps api, I can download a second map, map2, with just streets and water features for the same region.
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)
I would like to be able to layer map2 on top of the geoms like so:
ggmap(map1) + 
geom_point() + 
map2, alpha = 0.5 
The idea is to have a base map underneath the geoms and then be able to render the roads and water features on top of the geoms (points, stat_density, hex_bin, etc.)  

I couldn't see a viable means of converting ggmapraster (from get_map) into a data frame to enable a solution based on geom_map. Using inset_raster, I can plot map2 on top of map1 and the geoms but there does not appear to be a way to set the alpha level so that map2 doesn't opaquely cover up the geoms and map1.

Have I missed an obvious feature or is there a simple solution for layering two maps in the same plot?

Per DWin's comment, to get map2, I needed to modify get_map so that it would accept Google's style paramters.  Here's the code that supports the call to get map2 above.
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)
}

解决方案
The original problem is exactly solved using the ggmap version 2.0 inset_ggmap():
require(ggmap)

map.background <- get_map(c(lon = -122, lat = 47.5), map = "toner-background")
map.lines <- get_map(c(lon = -122, lat = 47.5), map = "toner-lines")
map.labels <- get_map(c(lon = -122, lat = 47.5), map = "toner-labels")

set.seed(127)
df <- data.frame(lon = rnorm(25, mean = -122.2, sd = 0.2),
                 lat = rnorm(25, mean = 47.5, sd = 0.1),
                 size = rnorm(25, mean = 15, sd = 5))

ggmap(map.background) +
  geom_point(data = df,
             aes(x = lon, y = lat, size = size),
             color = "blue", alpha = 0.8) + 
  scale_size_identity(guide = "none") + 
  inset_ggmap(map.lines) + 
  inset_ggmap(map.labels)


                        
这篇关于使用ggplot的ggmap函数将两个地图叠加在一起的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！