R 特定值上方和下方的geom_线的不同颜色

我有下面的数据框，我想绘制。我想知道是否有可能将连接结果变量（stackOne$y）的行的部分涂成不同的颜色，这取决于它是否小于某个值。例如，我希望低于2.2的部分线条是红色的

set.seed(123)
stackOne = data.frame(id = rep(c(1, 2, 3), each = 3),
                     y = rnorm(9, 2, 1),
                     x = rep(c(1, 2, 3), 3))

ggplot(stackOne, aes(x = x, y = y)) +
    geom_point() +
    geom_line(aes(group = id))

---

谢谢

这里至少有两种选择。第一种方法非常简单、通用（不限于直线段）且精确，但使用的是base

plot

，而不是

ggplot

。第二种使用的是

ggplot

，但稍微复杂一些，颜色转换不会100%精确（但足够接近，只要指定适当的分辨率…请继续阅读）

基础：

如果您愿意使用

base

打印功能而不是

ggplot

，则可以将打印区域剪裁到阈值（2.2）以上，然后以首选颜色打印线段，然后剪裁到阈值以下的区域，然后再次以红色打印。虽然第一个剪辑是完全不必要的，但它可以防止过涂不同的颜色，这可能看起来有点呆板

threshold <- 2.2
set.seed(123)
stackOne=data.frame(id=rep(c(1,2,3),each=3),
                y=rnorm(9,2,1),
                x=rep(c(1,2,3),3))
# create a second df to hold segment data
d <- stackOne 
d$y2 <- c(d$y[-1], NA)
d$x2 <- c(d$x[-1], NA) 
d <- d[-findInterval(unique(d$id), d$id), ] # remove last row for each group

plot(stackOne[, 3:2], pch=20)
# clip to region above the threshold
clip(min(stackOne$x), max(stackOne$x), threshold, max(stackOne$y))
segments(d$x, d$y, d$x2, d$y2, lwd=2)
# clip to region below the threshold
clip(min(stackOne$x), max(stackOne$x), min(stackOne$y), threshold)
segments(d$x, d$y, d$x2, d$y2, lwd=2, col='red')
points(stackOne[, 3:2], pch=20) # plot points again so they lie over lines

---

也许有一种方法可以通过ggplot函数实现这一点，但同时我希望这能有所帮助。我不知道如何在剪裁的

视口中绘制
ggplotGrob
（它似乎只是缩放绘图）。如果您希望颜色取决于某个x值阈值，这显然需要进行一些调整。
我的同事鼓励您回答一个更新但相关的问题，我也将在这里分享一个更易于使用的问题近似值

可以使用
ggforce:：geom_link2（）
对线进行插值，并使用
after_stat（）
在插值后指定正确的颜色，而不是精确地插值正确的值。如果需要更高的精度，可以增加该函数的
n

库（ggplot2）
图书馆（警队）
#>警告：包“ggforce”是在R版本4.0.3下生成的
种子集（123）
stackOne=data.frame（id=rep（c（1,2,3），每个=3），
y=rnorm（9，2，1），
x=代表（c（1,2,3,3））
ggplot（stackOne，aes（x=x，y=y））+
几何点（）+
geom_link2(
aes（组=id，
颜色=经过统计（y<2.2））
) +
比例\颜色\手册(
值=c（“黑色”、“红色”）
)


由（v1.0.0）于2021-03-26创建
谢谢。我听说melt函数对此类问题也很有用，但这听起来像是一个很好的解决方案。我已经编辑了该解决方案，其中包括了一种使用底图和
clip
ggplotGrob
使用内部视口本身的方法，这就是为什么剪裁不起作用的原因。@baptiste:谢谢。。我已经找到了哈德利，不确定你是否找到了解决方案（我想你没有）。谢谢你的解答，@jbaums！我已经冒昧地将它更新为dplyr和最近R可以做的最新花哨的东西。对于任何感兴趣的人，您可以在此处查看代码：
threshold <- 2.2 # set colour-transition threshold
yres <- 0.01 # y-resolution (accuracy of colour change location)

d <- stackOne # for code simplification
# new cols for point coordinates of line end
d$y2 <- c(d$y[-1], NA)
d$x2 <- c(d$x[-1], NA) 
d <- d[-findInterval(unique(d$id), d$id), ] # remove last row for each group
# new high-resolution y coordinates between each pair within each group
y.new <- apply(d, 1, function(x) {
  seq(x['y'], x['y2'], yres*sign(x['y2'] - x['y']))
})
d$len <- sapply(y.new, length) # length of each series of points
# new high-resolution x coordinates corresponding with new y-coords
x.new <- apply(d, 1, function(x) {
  seq(x['x'], x['x2'], length.out=x['len'])
})
id <- rep(seq_along(y.new), d$len) # new group id vector
y.new <- unlist(y.new)
x.new <- unlist(x.new)
d.new <- data.frame(id=id, x=x.new, y=y.new)

p <- ggplot(d.new, aes(x=x,y=y)) +
  geom_line(aes(group=d.new$id, color=d.new$y < threshold))+
  geom_point(data=stackOne)+
  scale_color_discrete(sprintf('Below %s', threshold))
p