R中的线密度热图

Question

问题描述
我有数千行（~4000）要绘制。然而，绘制所有线条是不可行的geom_line()，仅使用例如alpha=0.1来说明哪里有高密度的线，哪里没有。我在 Python 中遇到了类似的东西，尤其是答案的第二个图看起来非常好，但是如果可以在ggplot2. 因此是这样的：

一个示例数据集
用一组显示模式来证明这一点会更有意义，但现在我只是生成随机正弦曲线：

set.seed(1)
gen.dat <- function(key) {
    c <- sample(seq(0.1,1, by = 0.1), 1)
    time <- seq(c*pi,length.out=100)
    val <- sin(time)
    time = 1:100
    data.frame(time,val,key)
}
dat <- lapply(seq(1,10000), gen.dat) %>% bind_rows()

尝试过热图
我尝试了一个像这里回答的热图，但是这个热图不会考虑整个轴上点的连接（比如在一条线上），而是显示每个时间点的“热量” 。

问题
我们如何在 R 中使用ggplot2类似于第一张图所示的线绘制热图？

Answer 1

仔细观察，您会发现您所链接的图形由许多、许多、许多点而不是线组成。

该ggpointdensity包进行了类似的可视化。请注意，有这么多数据点，存在相当多的性能问题。我使用的是开发人员版本，因为它包含method允许使用不同平滑估计器的参数，并且显然有助于更好地处理更大的数字。也有 CRAN 版本。

您可以使用adjust参数调整平滑。

我增加了代码的 x 间隔密度，使其看起来更像线条。不过，稍微减少了情节中的“行”数。

library(tidyverse)
#devtools::install_github("LKremer/ggpointdensity")
library(ggpointdensity)

set.seed(1)
gen.dat <- function(key) {
  c <- sample(seq(0.1,1, by = 0.1), 1)
  time <- seq(c*pi,length.out=500)
  val <- sin(time)
  time = seq(0.02,100,0.1)
  data.frame(time,val,key)
}
dat <- lapply(seq(1, 1000), gen.dat) %>% bind_rows()

ggplot(dat, aes(time, val)) + 
  geom_pointdensity(size = 0.1, adjust = 10) 
#> geom_pointdensity using method='kde2d' due to large number of points (>20k)

^{由reprex 包(v0.3.0)于 2020 年 3 月 19 日创建}

更新 感谢用户 Robert Gertenbach 创建了一些更有趣的示例数据。这里建议在此数据上使用 ggpointdensity ：

library(tidyverse)
library(ggpointdensity)

gen.dat <- function(key) {
  has_offset <- runif(1) > 0.5
  time <- seq(1, 1000, length.out = 1000)
  val <- sin(time / 100 + rnorm(1, sd = 0.2) + (has_offset * 1.5)) * 
    rgamma(1, 20, 20)
  data.frame(time,val,key)
}

dat <- lapply(seq(1,1000), gen.dat) %>% bind_rows()
ggplot(dat, aes(time, val, group=key)) +stat_pointdensity(geom = "line", size = 0.05, adjust = 10) + scale_color_gradientn(colors = c("blue", "yellow", "red"))

^{由reprex 包(v0.3.0)于 2020 年 3 月 24 日创建}

Answer 2

您的数据将产生相当均匀的 polkadot 密度。

我生成了一些稍微有趣的数据，如下所示：

gen.dat <- function(key) {
  has_offset <- runif(1) > 0.5
  time <- seq(1, 1000, length.out = 1000)
  val <- sin(time / 100 + rnorm(1, sd = 0.2) + (has_offset * 1.5)) * 
    rgamma(1, 20, 20)
  data.frame(time,val,key)
}
dat <- lapply(seq(1,1000), gen.dat) %>% bind_rows()

然后我们得到二维密度估计。kde2d 没有predict函数，因此我们使用 LOESS 对其进行建模

dens <- MASS::kde2d(dat$time, dat$val, n = 400)
dens_df <- data.frame(with(dens, expand_grid( y, x)), z = as.vector(dens$z))
fit <- loess(z ~ y * x, data = dens_df, span = 0.02)
dat$z <- predict(fit, with(dat, data.frame(x=time, y=val)))

然后绘制它得到这样的结果：

ggplot(dat, aes(time, val, group = key, color = z)) +
  geom_line(size = 0.05) +
  theme_minimal() +
  scale_color_gradientn(colors = c("blue", "yellow", "red"))

这一切都高度依赖于：

• 系列数
• 系列分辨率
• kde2d 的密度
• 黄土跨度

所以你的里程可能会有所不同