Użyj zakrzywionych linii na wykresie wypukłości

Question

Próbuję zrobić wykres uderzeniowy (np. parallel coordinates, ale z ciągłą osią x), aby pokazać ranking w czasie. Mogę zrobić wykres liniową bardzo łatwo:

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

wspaniałe. Teraz jednak chcę, aby linie łączące były zakrzywione. Pomimo tego, że nigdy nie ma więcej niż 1 y na x, geom_smooth oferuje kilka możliwości. loess wygląda na to, że powinien działać, ponieważ może zignorować punkty, z wyjątkiem najbliższych. Jednak nawet z szczypanie najlepszy mogę nadal zdobywa wiele punktów i przeregulowania innych, gdzie powinno być płaskie:

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

Próbowałem kilka innych splajnów, jak ggalt::geom_xspline, ale wszystkie one nadal przekroczenia lub pominąć punkty:

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

Czy istnieje prosty sposób na krzywej te linie? Czy muszę zbudować własny splajn sigmoidalny? W celu wyjaśnienia, szukam czegoś podobnego D3.js's d3.curveMonotoneX który trafia do każdego punktu i którego lokalne minimum i maksimum nie przekracza wartości Y:

Idealnie byłoby prawdopodobnie mają nachylenie 0 w każdym punkcie, też, ale to nie jest absolutnie konieczne.

Answer 1

Używanie signal::pchip z siatką wartości X działa, przynajmniej w twoim przykładzie z osiami numerycznymi. Właściwa geom_ byłoby miło, ale hej ...

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

Wynik: