Использовать кривые линии на диаграмме ударов

Я пытаюсь создать диаграмму выступов (например, параллельные координаты, но с порядковой осью X), чтобы показать ранжирование во времени. Я могу очень легко сделать линейный график:

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

Замечательно. Теперь я хочу сделать соединительные линии изогнутыми. Несмотря на то, что geom_smooth никогда не имеет более одного y на x, geom_smooth предлагает некоторые возможности. loess кажется, что он должен работать, поскольку он может игнорировать точки, кроме самых близких. Тем не менее, даже с лучшей настройкой, которую я могу получить, все равно упускает много очков и обходит другие, где это должно быть плоским:

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

Я пробовал ряд других сплайнов, таких как ggalt::geom_xspline, но все они по-прежнему ggalt::geom_xspline или пропускают точки:

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

Есть ли простой способ изогнуть эти линии? Нужно ли мне строить свой собственный сигмоидальный сплайн? Чтобы уточнить, я ищу что-то вроде D3.js d3.curveMonotoneX который поражает каждую точку и чьи локальные максимумы и минимумы не превышают значения y:

d3.curveMonotoneX image

В идеале он, вероятно, также имеет наклон 0 в каждой точке, но это не является абсолютно необходимым.

Ответы

Ответ 1

Использование signal::pchip с сеткой значений X работает, по крайней мере, в вашем примере с числовыми осями. Правильный geom_ был бы приятным, но эй...

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

Результат: Result

Ответ 2

Основываясь на ответе Хенрика, это завершает pchip (здесь я использую один из pracma но результат тот же), чтобы его можно было использовать вместе с существующими гладкими методами:

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
}

Тогда фактический вызов ggplot прост:

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

Затем вы можете использовать pchip для сглаживания других геомов, например, площадных графиков:

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