在凹凸图中使用曲线
Use curved lines in bumps chart
我正在尝试制作一个颠簸图表(类似于 parallel coordinates,但具有有序的 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()
太棒了。不过,现在我想让连接线弯曲。尽管每个 x 的 y 永远不会超过一个,geom_smooth
提供了一些可能性。 loess
似乎应该可以工作,因为它可以忽略最近的点以外的点。然而,即使调整了我能得到的最好的结果,我仍然遗漏了很多点并且超过了其他应该平坦的点:
ggplot(df, aes(Var2, rank, color = Var1)) +
geom_smooth(method = 'loess', span = .7, se = FALSE) +
geom_point()
我已经尝试了一些其他的样条曲线,比如 ggalt::geom_xspline
,但它们仍然过冲或错过了点:
ggplot(df, aes(Var2, rank, color = Var1)) + ggalt::geom_xspline() + geom_point()
有没有简单的方法来弯曲这些线?我需要构建自己的 S 形样条曲线吗?为了澄清,我正在寻找类似 D3.js's d3.curveMonotoneX
的东西,它命中每个点并且其局部最大值和最小值不超过 y 值:
理想情况下,每个点的斜率也可能为 0,但这并非绝对必要。
将 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()
结果:
基于 Henrik 的回答,这总结了 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')
我正在尝试制作一个颠簸图表(类似于 parallel coordinates,但具有有序的 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()
太棒了。不过,现在我想让连接线弯曲。尽管每个 x 的 y 永远不会超过一个,geom_smooth
提供了一些可能性。 loess
似乎应该可以工作,因为它可以忽略最近的点以外的点。然而,即使调整了我能得到的最好的结果,我仍然遗漏了很多点并且超过了其他应该平坦的点:
ggplot(df, aes(Var2, rank, color = Var1)) +
geom_smooth(method = 'loess', span = .7, se = FALSE) +
geom_point()
我已经尝试了一些其他的样条曲线,比如 ggalt::geom_xspline
,但它们仍然过冲或错过了点:
ggplot(df, aes(Var2, rank, color = Var1)) + ggalt::geom_xspline() + geom_point()
有没有简单的方法来弯曲这些线?我需要构建自己的 S 形样条曲线吗?为了澄清,我正在寻找类似 D3.js's d3.curveMonotoneX
的东西,它命中每个点并且其局部最大值和最小值不超过 y 值:
理想情况下,每个点的斜率也可能为 0,但这并非绝对必要。
将 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()
结果:
基于 Henrik 的回答,这总结了 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')