具有一维密度图对齐的密度热图

Question

我正在使用this post 中概述的方法在与一维 x 和 y 密度图配对的地图上创建密度热图。我能够生成以下图像：Density Heatmap

但是，我很难将顶部密度图中的阴影区域与地图上的热图对齐。我发现这与我在代码中应用墨卡托投影来生成热图有关，而顶部和右侧的密度图只是使用数据中的坐标。

有没有办法可以将热图中的投影坐标与一维密度图中的非投影坐标对齐？

下面是我的代码的相关部分（我使用了 grid/gtable 包来组合不同的图表）。

编辑：数据由三列组成：UniqueID、Lon 和 Lat。在这种情况下，所有 Lon/Lat 对都在纽约市内/附近，但出于故障排除目的，只要可以预测准确的对并不重要。

library(gtable)
library(ggplot2)   
library(ggmap) 

ny <- get_map(location = "Washington Heights, New York City", zoom = 12, color = "bw")

    ggm <- ggmap(ny, extent = "normal", maprange = F) %+% data +
          aes(x = Lon, y = Lat) +
          stat_density2d(aes(fill = ..level..,
                             alpha = ..level..), color = "darkgreen",
                         geom = "polygon", show.legend = TRUE) +
          geom_polygon(aes(x, y), 
                       data.frame(x = c(Inf, Inf, -73.90, -73.90), y = c(Inf, 40.84, 40.84, Inf)),
                       alpha = 0.5, colour = NA, fill = "red") +
          coord_map(projection = "mercator",
                    xlim = c(attr(ny, "bb")$ll.lon, attr(ny, "bb")$ur.lon),
                    ylim = c(attr(ny, "bb")$ll.lat, attr(ny, "bb")$ur.lat))

    xd <- data.frame(density(data$Lon)[c("x", "y")])
    gg1 <- ggplot(xd, aes(x, y)) +
      theme(panel.grid.minor = element_line(colour = NA),
                panel.background = element_rect(fill = NA, colour = NA)) +
      labs(y = "Density") +
      geom_area(data = subset(xd, x > -73.90), fill = "red") +
      geom_line() +
      coord_cartesian(c(attr(ny, "bb")$ll.lon, attr(ny, "bb")$ur.lon))

image <- gtable_filter(ggplotGrob(ggm), pattern = "panel", trim = TRUE, fixed=TRUE)
image <- gtable_add_cols(image, unit(0.2, "null"), 1)
image <- gtable_add_grob(image, gtable_filter(ggplotGrob(gg1), pattern = "panel", trim = TRUE, fixed=TRUE), 1, 1) 

Answer 1

我认为问题与投影无关。如果您检查顶部密度图的 x 范围和地图的 x 范围，我认为它们不一样。同样，右侧密度图的 y 范围与地图的 y 范围相比。代码见底部。范围不同的原因是，默认情况下，ggmap 没有轴的扩展因子，而默认情况下 ggplot 有扩展因子。在两个密度图中设置expand = c(0,0)。

似乎还有一个问题。需要翻转正确的密度图，但翻转会干扰通过coord_cartesian 设置的限制。如果我使用xlim（和ylim）设置限制，那么在翻转后限制仍然存在。

library(ggmap)
library(gtable)
library(ggplot2)    
library(grid)


ny <- get_map(location = "Washington Heights, New York City", zoom = 12, color = "bw")

# Pretend data
set.seed(5126)
df = data.frame(Lon = rnorm(100, mean = -73.90, sd = .015), Lat = rnorm(100, mean = 40.84, sd = .015))

# Map
   ggm <- ggmap(ny, extent = "normal", maprange = F) %+% df +
          aes(x = Lon, y = Lat) +  
          stat_density2d(aes(fill = ..level..,
                             alpha = ..level..),
                         geom = "polygon", show.legend = TRUE) +
          geom_polygon(aes(x, y), 
                       data.frame(x = c(Inf, Inf, -73.90, -73.90), y = c(Inf, 40.84, 40.84, Inf)),
                       alpha = 0.5, colour = NA, fill = "red") + geom_point() +
          coord_map(projection = "mercator", 
                    xlim = c(attr(ny, "bb")$ll.lon, attr(ny, "bb")$ur.lon),
                    ylim = c(attr(ny, "bb")$ll.lat, attr(ny, "bb")$ur.lat)) 


# Top density plot
xd <- data.frame(density(df$Lon)[c("x", "y")])

gg1 <- ggplot(xd, aes(x, y)) +
  theme(panel.grid.minor = element_line(colour = NA),
        panel.background = element_rect(fill = NA, colour = NA)) +
  labs(y = "Density") +
  geom_area(data = subset(xd, x > -73.90), fill = "red") +
  geom_line() +
  scale_x_continuous(limits = c(attr(ny, "bb")$ll.lon, attr(ny, "bb")$ur.lon), expand = c(0,0)) 

image <- gtable_filter(ggplotGrob(ggm), pattern = "panel", trim = TRUE, fixed=TRUE)
image <- gtable_add_rows(image, unit(0.2, "null"), 0)
image <- gtable_add_grob(image, gtable_filter(ggplotGrob(gg1), pattern = "panel", trim = TRUE, fixed=TRUE), 1, 1) 

grid.newpage()
grid.draw(image)


# Right density plot
xd <- data.frame(density(df$Lat)[c("x", "y")])

gg2 <- ggplot(xd, aes(x, y)) +
   theme(panel.grid.minor = element_line(colour = NA),
         panel.background = element_rect(fill = NA, colour = NA)) +
   labs(y = "Density") +
   geom_area(data = subset(xd, x > 40.84), fill = "red") + 
   geom_line() + 
   scale_x_continuous(limits = c(attr(ny, "bb")$ll.lat, attr(ny, "bb")$ur.lat), expand = c(0,0)) +
   coord_flip() 

image <- gtable_add_cols(image, unit(0.2, "null"), 1)
image <- gtable_add_grob(image, gtable_filter(ggplotGrob(gg2), pattern = "panel", trim = TRUE, fixed=TRUE), 2, 2) 

grid.newpage()
grid.draw(image)

编辑更新到 ggplot2 ver 3.0.0

# Check that the ranges for the density plots are the same as the ranges for the map
top = ggplot_build(gg1)
right = ggplot_build(gg2)
map = ggplot_build(ggm)

top$layout$panel_params[[1]]$x.range
map$layout$panel_params[[1]]$x.range

right$layout$panel_params[[1]]$y.range
map$layout$panel_params[[1]]$y.range