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

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

1 个答案: