Rの線密度ヒートマップ

問題の説明
プロットしたい数千行（約4000）があります。ただし、すべての線を使用してプロットすることは不可能でありgeom_line()、たとえばalpha=0.1、線の密度が高い場所とない場所を示すためだけに使用することはできません。私はPythonで似たようなものに出くわしました。特に、回答の2番目のプロットは本当に良さそうですが、似たようなものをで達成できるかどうかはわかりません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ますか？

あなたのデータは非常に均一な水玉模様の密度になります。

私はこのような少し興味深いデータをいくつか生成しました：

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()

次に、2D密度推定を取得します。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の密度
• 黄土のスパン

あなたの走行距離は異なる場合があります

よく見ると、リンクしているグラフは、線ではなく多くの、多くの、多くの点で構成されていることがわかります。

ggpointdensityパッケージには、同様の可視化を行います。非常に多くのデータポイントがあるため、パフォーマンスにかなりの問題があることに注意してください。私は開発者バージョンを使用していmethodます。これには、さまざまな平滑化推定量を使用できるようにする引数が含まれており、明らかに大きな数の処理に役立つからです。クランバージョンもあります。

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)

^{2020-03-19にreprexパッケージ（v0.3.0）によって作成されました}

update 興味深いサンプルデータを作成して くれたユーザー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"))

^{2020-03-24にreprexパッケージ（v0.3.0）によって作成されました}

私が使用して、以下の解決策を考え出したgeom_segment()場合、私はわからないが、geom_segment()それとしてのみチェックを移動するための方法であるペアワイズ値がある場合、正確に（私の質問のように）ヒートマップ内で互いに近い値も影響を与えるのに対し、同じまったく同じというよりはむしろ「熱」。

# Simple stats to get all possible line segments
vals <- unique(dat$time)
min.val = min(vals)
max.val = max(vals)

# Get all possible line segments
comb.df <- data.frame(
  time1 = min.val:(max.val - 1),
  time2 = (min.val + 1): max.val
)

# Join the original data to all possible line segments
comb.df <- comb.df %>% 
  left_join(dat %>% select(time1 = time, val1 = val, key )) %>%
  left_join(dat %>% select(time2 = time, val2 = val, key ))

# Count how often each line segment occurs in the data
comb.df <- comb.df %>% 
  group_by(time1, time2, val1, val2) %>%
  summarise(n = n_distinct(key))

# ggplot2 to plot segments
ggplot(comb.df %>% arrange(n)) +
  geom_segment(aes(x = time1, y = val1, xend = time2, yend = val2, color = n), alpha =0.9) +
  scale_colour_gradient( low = 'green', high = 'red')  +
  theme_bw()