Verwenden Sie gekrümmte Linien in Beulen Diagramm

Question

Ich versuche, ein Reliefdiagramm (wie parallel coordinates, aber mit einer kontinuierlichen x-Achse), um Ranking im Laufe der Zeit zu zeigen. Ich kann einen geraden Liniendiagramm machen sehr leicht:

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

Wunderbar. Jetzt möchte ich aber die Verbindungslinien kurven. Obwohl Sie nie mehr als ein Jahr pro Stück haben, bietet geom_smooth einige Möglichkeiten. loess scheint wie es sollte funktionieren, da es Punkte außer dem nächsten ignorieren kann. Doch selbst mit den besten zwicken Ich kann immer noch vermisst viele Punkte bekommen und Überhöhungen andere, wo es eben sein sollte:

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

ich eine Reihe von anderen Splines versucht haben, wie ggalt::geom_xspline, aber sie alle noch überschreiten oder verfehlen die Punkte:

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

gibt es eine einfache Art und Weise zu krümmen diese Zeilen? Muss ich meinen eigenen sigmoidalen Spline bauen? Um zu klären, ich bin auf der Suche nach so etwas wie D3.js's d3.curveMonotoneX, die jeden Punkt treffen und lokale Maxima und Minima, die nicht die y-Werte nicht überschreiten:

Ideal wäre es wahrscheinlich eine Neigung von 0 an jedem Punkt hat, auch, aber das ist nicht unbedingt notwendig.

Answer 1

Die Verwendung von signal::pchip mit einem Raster von X-Werten funktioniert, zumindest in Ihrem Beispiel mit numerischen Achsen. Eine richtige geom_ wäre schön, aber hey ...

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

Ergebnis: