r - shinythemes - tags$div shiny

Usa líneas curvas en el gráfico de baches.

Question

Estoy tratando de hacer un gráfico de baches (como coordenadas paralelas pero con un eje x ordinal) para mostrar la clasificación en el tiempo. Puedo hacer un gráfico de línea recta muy fácilmente:

library(ggplot2)
set.seed(47)

df <- as.data.frame(as.table(replicate(8, sample(4))), responseName = ''rank'')
df$Var2 <- as.integer(df$Var2)

head(df)
#>   Var1 Var2 rank
#> 1    A    1    4
#> 2    B    1    2
#> 3    C    1    3
#> 4    D    1    1
#> 5    A    2    3
#> 6    B    2    4

ggplot(df, aes(Var2, rank, color = Var1)) + geom_line() + geom_point()

Maravilloso. Ahora, sin embargo, quiero hacer que las líneas de conexión sean curvas. A pesar de no tener más de un año por x, geom_smooth ofrece algunas posibilidades. loess parece que debería funcionar, ya que puede ignorar puntos excepto los más cercanos. Sin embargo, incluso con ajustes lo mejor que puedo obtener, me falta muchos puntos y sobrepasa a otros donde debería ser plano:

ggplot(df, aes(Var2, rank, color = Var1)) + 
    geom_smooth(method = ''loess'', span = .7, se = FALSE) + 
    geom_point()

He intentado una serie de otras splines, como ggalt::geom_xspline , pero todas todavía superan o pierden los puntos:

ggplot(df, aes(Var2, rank, color = Var1)) + ggalt::geom_xspline() + geom_point()

¿Hay una manera fácil de curvar estas líneas? ¿Necesito construir mi propia spline sigmoidal? Para aclarar, estoy buscando algo como el d3.curveMonotoneX de D3.js que d3.curveMonotoneX todos los puntos y cuyos máximos y mínimos locales no superan los valores de y:

Lo ideal sería que también tuviera una pendiente de 0 en cada punto, pero eso no es absolutamente necesario.

Answer 1

El uso de signal::pchip con una cuadrícula de valores X funciona, al menos en su ejemplo con ejes numéricos. Un geom_ apropiado sería bueno, pero oye ...

library(tidyverse)
library(signal)
set.seed(47)

df <- as.data.frame(as.table(replicate(8, sample(4))), responseName = ''rank'')
df$Var2 <- as.integer(df$Var2)

head(df)
#>   Var1 Var2 rank
#> 1    A    1    4
#> 2    B    1    2
#> 3    C    1    3
#> 4    D    1    1
#> 5    A    2    3
#> 6    B    2    4

ggplot(df, aes(Var2, rank, color = Var1)) +
  geom_line(data = df %>%
              group_by(Var1) %>%
              do({
                tibble(Var2 = seq(min(.$Var2), max(.$Var2),length.out=100),
                       rank = pchip(.$Var2, .$rank, Var2))
              })) +
  geom_point()

Resultado:

Answer 2

Sobre la base de la respuesta de Henrik, esto envuelve el pchip (estoy usando el de la pracma aquí pero el resultado es el mismo), por lo que se puede usar más fácilmente junto con los métodos suaves existentes:

ggpchip = function(formula, data, weights) structure(pracma::pchipfun(data$x, data$y), class=''ggpchip'')
predict.ggpchip = function(object, newdata, se.fit=F, ...) {
  fit = unclass(object)(newdata$x)
  if (se.fit) list(fit=data.frame(fit, lwr=fit, upr=fit), se.fit=fit * 0) else fit
}

Entonces la llamada real de ggplot es directa:

ggplot(df, aes(Var2, rank, color=Var1)) + geom_smooth(method=''ggpchip'', se=F) + geom_point()

Luego puede usar pchip para suavizar otros geoms, por ejemplo, parcelas de área:

ggplot(df, aes(Var2, rank, fill=Var1)) + stat_smooth(method=''ggpchip'', geom=''area'', position=''fill'')