r - 热图透明度、着色和特异性不令人满意

Question

v <- 2^(7:17)
min_lon <- 6.164780
max_lon <- 15.744857
min_lat <- 47.228296
max_lat <- 54.426407
center_lon <- (min_lon + max_lon)/2
center_lat <- (min_lat + max_lat)/2

df <- data.frame(id = 1:sum(v))
df$T <- rep(paste("T", v, sep="_"), v)
df$lon <- runif(sum(v),min_lon, max_lon)
df$lat <- runif(sum(v),min_lat,max_lat)

制作透明度=..level..的热图

gg_heatmap <- function(T){
    g <- ggmap(get_map(location=c(lat=center_lat, lon=center_lon), zoom=6, maptype="roadmap", source="google"))
    g <- g + scale_fill_gradientn(colours=rev(rainbow(100, start=0, end=0.75)))
    g <- g + stat_density2d(data=df[df$T == "T_1024",], aes(x = lon, y = lat,fill = ..level..,transparency=..level..), 
                            size=1, bins=100, geom = 'polygon')
    print(g)
}

system.time(gg_heatmap("T_1024"))

通过设置 alpha = .05 制作热图

gg_heatmap <- function(T){
    g <- ggmap(get_map(location=c(lat=center_lat, lon=center_lon), zoom=6, maptype="roadmap", source="google"))
    g <- g + scale_fill_gradientn(colours=rev(rainbow(100, start=0, end=0.75)))
    g <- g + stat_density2d(data=df[df$T == "T_1024",], aes(x = lon, y = lat,fill = ..level..), alpha=.05,
                            size=1, bins=100, geom = 'polygon')
    print(g)
}

system.time(gg_heatmap("T_1024"))

两个结果都不令人满意。我更希望看到类似以下使用 QlikView 制作的热图并使用相同的数据集“T_1024”。



QV版本我比较喜欢三个方面:

透明度允许仍然看到下面的 map ...

...而颜色仍然富有表现力而不是苍白

着色允许识别更多细节

我试图通过尝试不同的方法来静态设置 alpha 级别以及相对于 ..level.. 来解决 (1)，但我无法获得好的结果。透明度从来都不是很好，如果我看到 map 颜色太淡了。

(3) 我认为我可以通过设置高 bin 值来影响。

任何想法如何优化热图渲染或至少它的方面？

Answer 1

注意:归功于 this post对于答案的基本结构。

这会生成一个热图，其中轮廓清晰可辨，下面的 map 是可见的。与您的代码的主要区别是:

已删除 size=...和 bins=...论据。不需要size (它在这里什么都不做)。

替换 transparency=..levels.. (那是什么？？)，与 alpha=..levels.. .

添加 scale_alpha_continuous(...) ，在 alpha 中设置范围限制并关闭 alpha 指南。

.

library(ggplot2)
library(ggmap)
gg_heatmap <- function(){
  g <- ggmap(get_map(location=c(lat=center_lat, lon=center_lon), zoom=6, maptype="roadmap", source="google"))
  g <- g + scale_fill_gradientn(colours=rev(rainbow(100, start=0, end=0.75)))
  g <- g + stat_density2d(data=df[df$T == "T_1024",], aes(x = lon, y = lat,fill = ..level..,alpha=..level..), 
                           geom = 'polygon')
  g <- g +   scale_alpha_continuous(guide="none",range=c(0,.4))
  print(g)
}
gg_heatmap()

请注意，我使用了 set.seed(1)创建之前 df对于可重复的示例。如果你想要相同的情节，你需要添加它。

编辑 对 OP 评论的回应。
stat_density2d(...)通过定义轮廓并绘制填充多边形来包围它们，因此根据定义，轮廓将是“前卫的”。如果您想模糊轮廓，您可能必须使用平铺方法。不幸的是，这需要计算 ggplot 之外的 2D 核密度估计值。 :

gg_heatmap <- function(T){
  require(MASS)
  require(ggplot2)
  require(ggmap)
  d <- with(df[df$T==T,], kde2d(lon,lat,h=c(1.5,1.5),n=100))
  d.df <- expand.grid(lon=d[[1]],lat=d[[2]])
  d.df$z <- as.vector(d$z)
  g <- ggmap(get_map(location=c(lat=center_lat, lon=center_lon), zoom=6, maptype="roadmap", source="google"))
  g <- g + scale_fill_gradientn(colours=rev(rainbow(100, start=0, end=0.75)))
  g <- g + geom_tile(data=d.df, aes(x=lon,y=lat,fill=z),alpha=.8)
  print(g)
}
gg_heatmap("T_1024")

从数据可视化的角度来看，这个图明显不如第一个。是否“更漂亮”是一个见仁见智的问题。