Mapa de calor de densidade de linha em R

8

Descrição do problema
Tenho milhares de linhas (~ 4000) que quero plotar. No entanto, é inviável plotar todas as linhas usando geom_line()e apenas usando, por exemplo, alpha=0.1para ilustrar onde há uma alta densidade de linhas e onde não. Me deparei com algo semelhante em Python , especialmente o segundo gráfico das respostas parece muito bom, mas não o faço agora se algo semelhante puder ser alcançado ggplot2. Assim, algo como isto: insira a descrição da imagem aqui

Um exemplo de conjunto de dados
Seria muito mais sensato demonstrar isso com um conjunto que mostra um padrão, mas, por enquanto, eu apenas gerava curvas sinusais aleatórias:

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

Tentei um mapa de calor
Tentei um mapa de calor como o respondido aqui , no entanto, este mapa de calor não considerará a conexão de pontos sobre o eixo completo (como em uma linha), mas mostrará o "calor" por ponto de tempo.

Pergunta
Como podemos em R, usando o ggplot2gráfico de um mapa de calor de linhas semelhante ao mostrado na primeira figura?

CodeNoob
fonte

Respostas:

3

Seus dados resultarão em uma densidade polkadot bastante uniforme.

Eu gerei alguns dados um pouco mais interessantes 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()

Em seguida, obtemos uma estimativa de densidade 2d. O kde2d não possui uma predictfunção, então nós o modelamos com um 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)))

Ao plotá-lo, obtém-se 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"))

insira a descrição da imagem aqui

Tudo isso é altamente dependente de:

  • O número de séries
  • A resolução de séries
  • A densidade do kde2d
  • O período de loess

então sua milhagem pode variar

Robin Gertenbach
fonte
Isso parece muito legal!
CodeNoob 24/03
1
Experimente a sugestão da biblioteca de Tjebo nos meus dados comggplot(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
Isso é legal mesmo. Obrigado por fornecer um bom exemplo de dados e, de fato, isso parece ótimo comggpointdensity
Tjebo 24/03
Atualizei minha resposta com seus dados. Mais uma vez obrigado
Tjebo
1
Obrigado pelo bountry, Tjebo :) Acho que, em última análise, o ggpointdensity alcança um hearmap de aparência mais agradável. Gostaria de saber se a sua densidade é precisa, pois a densidade em ~ 250, -0,5 é semelhante à de 375 -0,5, mas isso poderia ser apenas o gradiente
Robin Gertenbach
6

Observando atentamente, pode-se ver que o gráfico ao qual você está vinculando consiste em muitos, muitos, muitos pontos em vez de linhas.

O ggpointdensitypacote faz uma visualização semelhante. Observe que, com tantos pontos de dados, existem alguns problemas de desempenho. Estou usando a versão do desenvolvedor, porque contém o methodargumento que permite usar diferentes estimadores de suavização e aparentemente ajuda a lidar melhor com números maiores. Também existe uma versão CRAN.

Você pode ajustar a suavização com o adjustargumento

Aumentei a densidade do intervalo x do seu código, para torná-lo mais parecido com linhas. No entanto, reduzimos ligeiramente o número de 'linhas' na 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)

Criado em 2020-03-19 pelo pacote reprex (v0.3.0)

update Agradecemos ao usuário Robert Gertenbach por criar alguns dados de amostra mais interessantes . Aqui, o uso sugerido de ggpointdensity nesses dados:

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

Criado em 2020-03-24 pelo pacote reprex (v0.3.0)

Tjebo
fonte
Obrigado pela resposta. Tecnicamente, todas as linhas e gráficos de dispersão (ponto) podem ser intercambiados, mas isso depende dos dados subjacentes - na minha pergunta, as imagens claramente visam mostrar um padrão / correlação ao invés do "tremor" dos pontos. Para ilustrar, em sua trama, a estrutura sinusal subjacente e caracterizadora não é aparente.
CodeNoob 19/03
@CodeNoob os dados da amostra podem não ser ideais. Acho possível ver o padrão - ele está criando naturalmente uma grade regular. Em geral, se você converter linhas em pontos, o método funcionará. Mas essa também é a razão pela qual coloco uma recompensa em sua pergunta, porque pode haver melhores idéias para soluções por aí. Ache isso um problema interessante.
Tjebo 19/03
1
@ codenoob Se você se esforçar para ver o padrão, diminua a imagem, para parar para ver os pontos únicos. o mesmo acontece na imagem de exemplo que você forneceu. é uma questão de resolução.
Tjebo 19/03
1
Usando isso nos meus dados com 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 em algo realmente bonito!
Robin Gertenbach 24/03
-1

Eu vim com a seguinte solução, usando geom_segment(), no entanto, não tenho certeza se geom_segment()é o caminho a seguir, pois apenas verifica se os valores em pares são exatamente os mesmos, enquanto em um mapa de calor (como na minha pergunta) os valores próximos um do outro também afetam o 'calor' ao invés de ser exatamente o mesmo.

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

insira a descrição da imagem aqui

CodeNoob
fonte