Mapa de calor de densidad de línea en R

8

Descripción del problema
Tengo miles de líneas (~ 4000) que quiero trazar. Sin embargo, no es factible trazar todas las líneas usando geom_line()y solo usar, por ejemplo, alpha=0.1para ilustrar dónde hay una alta densidad de líneas y dónde no. Encontré algo similar en Python , especialmente la segunda trama de las respuestas se ve muy bien, pero ahora no sé si se puede lograr algo similar ggplot2. Entonces algo como esto: ingrese la descripción de la imagen aquí

Un conjunto de datos de ejemplo
Tendría mucho más sentido demostrar esto con un conjunto que muestra un patrón, pero por ahora solo generé curvas sinusales aleatorias:

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

Probé un mapa de calor Probé
un mapa de calor como el que he respondido aquí , sin embargo, este mapa de calor no considerará la conexión de puntos sobre el eje completo (como en una línea), sino que mostrará el "calor" por punto de tiempo.

Pregunta
¿Cómo podemos en R, usando ggplot2trazar un mapa de calor de líneas similares al que se muestra en la primera figura?

CodeNoob
fuente

Respuestas:

3

Sus datos darán como resultado una densidad de polkadot bastante uniforme.

Generé algunos datos un poco más interesantes como este:

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

Luego obtenemos una estimación de densidad 2D. kde2d no tiene una predictfunción, por lo que lo modelamos con 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)))

Al trazarlo se obtiene este resultado:

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

ingrese la descripción de la imagen aquí

Todo esto depende en gran medida de:

  • El número de series
  • La resolución de series
  • La densidad de kde2d
  • El lapso de loess

Así que su millaje puede variar

Robin Gertenbach
fuente
¡Esto se ve realmente genial!
CodeNoob
1
Pruebe la sugerencia de la biblioteca de Tjebo en mis datos conggplot(dat, aes(time, val, group=key)) +stat_pointdensity(geom = "line", size = 0.05, adjust = 10) + scale_color_gradientn(colors = c("blue", "yellow", "red"))
Robin Gertenbach
Eso es bueno de hecho. Gracias por proporcionar una buena muestra de datos y, de hecho, esto se ve muy bien conggpointdensity
Tjebo
He actualizado mi respuesta con tus datos. Gracias de nuevo
Tjebo
1
Gracias por el bountry, Tjebo :) Creo que, en última instancia, ggpointdensity logra un mapa de sonido más agradable. Me pregunto si su densidad es precisa ya que la densidad a ~ 250, -0.5 es similar a la de 375 -0.5, pero eso podría ser el gradiente
Robin Gertenbach
6

Mirando de cerca, uno puede ver que el gráfico al que está vinculando consiste en muchos, muchos, muchos puntos en lugar de líneas.

El ggpointdensitypaquete hace una visualización similar. Tenga en cuenta que con tantos puntos de datos, hay bastantes problemas de rendimiento. Estoy usando la versión de desarrollador, porque contiene el methodargumento que permite usar diferentes estimadores de suavizado y aparentemente ayuda a lidiar mejor con números más grandes. También hay una versión CRAN.

Puede ajustar el suavizado con el adjustargumento.

He aumentado la densidad del intervalo x de su código, para que se vea más como líneas. Sin embargo, he reducido ligeramente el número de 'líneas' en la trama.

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)

Creado en 2020-03-19 por el paquete reprex (v0.3.0)

actualización Gracias al usuario Robert Gertenbach por crear algunos datos de muestra más interesantes . Aquí el uso sugerido de ggpointdensity en estos datos:

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

Creado en 2020-03-24 por el paquete reprex (v0.3.0)

Tjebo
fuente
Gracias por la respuesta. Técnicamente, cada gráfico de línea y dispersión (punto) puede intercambiarse, pero depende de los datos subyacentes, si las imágenes proporcionadas en mi pregunta tienen como objetivo mostrar claramente un patrón / correlación en lugar de la "fluctuación" de puntos. Para ilustrar, en su diagrama, la estructura sinusal subyacente y caracterizante no es aparente.
CodeNoob
@CodeNoob los datos de la muestra pueden no ser ideales. Creo que es posible ver el patrón: naturalmente, está creando una cuadrícula regular. En general, si convierte líneas en puntos, el método debería funcionar. Pero esa es también la razón por la que pongo una recompensa por su pregunta, porque puede haber mejores ideas para encontrar soluciones. Encuentra este un problema interesante.
Tjebo
1
@codenoob si te cuesta ver el patrón, haz que la imagen sea más pequeña, de modo que te detengas a ver los puntos individuales. Lo mismo sucede en la imagen de ejemplo que proporcionó. Es una cuestión de resolución.
Tjebo
1
¡Usar esto en mis datos con ggplot(dat, aes(time, val, group=key)) +stat_pointdensity(geom = "line", size = 0.05, adjust = 10) + scale_color_gradientn(colors = c("blue", "yellow", "red"))resultados en algo realmente guapo!
Robin Gertenbach
-1

Se me ocurrió la siguiente solución, usando geom_segment(), sin embargo, no estoy seguro de si geom_segment()es el camino a seguir, ya que solo comprueba si los valores por pares son exactamente iguales, mientras que en un mapa de calor (como en mi pregunta) los valores cercanos también afectan el "calor" en lugar de ser exactamente lo mismo.

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

ingrese la descripción de la imagen aquí

CodeNoob
fuente