使用`ggplot2`中的`geom_curve`将一个位置相同但开头和结尾被切掉的曲线叠加在另一个曲线上。

Question

我有一个带有曲线信息的df：

df <- data.frame(
  x = c(0,0,1,1),
  xend = c(0,1,1,0),
  y = c(0,1,0,1),
  yend = c(1,0,1,1),
  curvature = c(-.2,-.5,.1,1)
)

我可以使用单独的曲率参数绘制这些曲线（灵感来自此处）：

library(ggplot2)
ggplot(df) + 
  lapply(split(df, 1:nrow(df)), function(dat) {
    geom_curve(data = dat, aes(x = x, y = y, xend = xend, yend = yend), curvature = dat["curvature"]) }
  ) + xlim(-1,2) + ylim(-1,2) + theme_void()

现在我想要在同一幅图像上重叠相同的曲线，但每条曲线的开头和结尾都应该被削减约10%。

起初，我以为我可能能够使用我的gg对象中的信息，但无法看到ggplot2存储信息的位置（请参见我的问题here）。

然后我尝试使用以下方法重新调整起点和终点：

offset <- function(from, to) return((to - from)/10)

recalculate_points <- function(df) {
  df$x <- df$x + offset(df$x, df$xend)
  df$xend = df$xend - offset(df$x, df$xend)
  df$y = df$y + offset(df$y, df$yend)
  df$yend = df$yend - offset(df$y, df$yend)
  return(df)
}

df2 <- recalculate_points(df)

ggplot(df) + 
  lapply(split(df, 1:nrow(df)), function(dat) {
    geom_curve(data = dat, aes(x = x, y = y, xend = xend, yend = yend), curvature = dat["curvature"]) }
  )  + 
  lapply(split(df2, 1:nrow(df2)), function(dat) {
    geom_curve(data = dat, aes(x = x, y = y, xend = xend, yend = yend), curvature = dat["curvature"], color = "red") }
  ) + xlim(-1,2) + ylim(-1,2) + theme_void()

像这样，我可以剪切曲线的开头和结尾。但是我们可以看到，红色曲线与原始的黑色曲线不太匹配。

我如何改进我的offset和recalculate_points函数，以使红色曲线更好地适配黑色曲线？

或者更好的是：我在gg对象中可以在哪里找到曲线信息，以及如何使用该信息重新调整我的曲线？

注意：我不需要100%的匹配。但是拟合应该在视觉上得到改善。因此，我的期望输出应该类似于：

- symbolrush

---

你是否正在尝试添加阴影？ - zx8754

@zx8754：不是的。我试图剪切箭头，以便它们不会覆盖标签。想象一下在曲线相交处每个点都有标签。最初，我认为在geom_curve内部或者有一个更适合我的需求的geom选项，并发布了这个问题。由于似乎没有简单的解决方案，我将问题精炼为更具体的曲线切割部分。 - symbolrush

为什么不把标签放在最后绘制： ... + geom_label(aes(x, y, label = curvature))，即在连接点的上方绘制。 - zx8754

@zx8754：感谢你的提示。不幸的是，这并不能真正地帮助到我。因为标签将会覆盖箭头头部，而且标签不应该有黑色线围绕它们（与geom_label相比）。 - symbolrush

我理解需求，只是想省事。是的，箭头不能与带框标签一起使用。 - zx8754

Answer 1

我找到了第一个解决方案。它有点复杂，但似乎可以工作。仍然非常欢迎改进和替代方案！

---

开始吧：

1. 计算所有曲线的起点和终点的角度；
2. 找到给定长度的向量，从起点和终点开始，并具有来自第1点的角度；
3. 重新计算x、xend、y、yend以适应曲线；
4. 重新计算curvature参数（需要稍微减小一些）。

---

详细说明并附上代码：

步骤0：初始化和默认图

df <- data.frame(
  x = c(0,0,1,1),
  xend = c(0,1,1,0),
  y = c(0,1,0,1),
  yend = c(1,0,1,1),
  curvature = c(-.2,-.5,.1,1)
)


library(ggplot2)
gg <- ggplot(df) + 
  lapply(split(df, 1:nrow(df)), function(dat) {
    geom_curve(data = dat, aes(x = x, y = y, xend = xend, yend = yend), curvature = dat["curvature"], color = "grey") }
  ) + xlim(-1,2) + ylim(-1,2) + theme_void()
gg

步骤1：角度

angles <- function(df) {
  df$theta <- atan2((df$y - df$yend), (df$x - df$xend))
  df$theta_end <- df$theta + df$curvature * (pi/2)
  df$theta <- atan2((df$yend - df$y), (df$xend - df$x))
  df$theta_start <- df$theta - df$curvature * (pi/2)
  return(df)
}

df <- angles(df)
df
  x xend y yend curvature      theta theta_end theta_start
1 0    0 0    1      -0.2  1.5707963 -1.884956    1.884956
2 0    1 1    0      -0.5 -0.7853982  1.570796    0.000000
3 1    1 0    1       0.1  1.5707963 -1.413717    1.413717
4 1    0 1    1       1.0  3.1415927  1.570796    1.570796

步骤2-4：角度，向量，重新计算的点和曲率

starts <- function(df, r) {
  df$x <- cos(df$theta_start) * r + df$x
  df$y <- sin(df$theta_start) * r + df$y
  return(df)
}

df <- starts(df, .1)

ends <- function(df, r) {
  df$xend <- cos(df$theta_end) * r + df$xend
  df$yend <- sin(df$theta_end) * r + df$yend
  return(df)
}

df <- ends(df, .1)

df$curvature <- df$curvature * .9
df

           x          xend          y      yend curvature      theta theta_end theta_start
1 -0.0309017 -3.090170e-02 0.09510565 0.9048943     -0.18  1.5707963 -1.884956    1.884956
2  0.1000000  1.000000e+00 1.00000000 0.1000000     -0.45 -0.7853982  1.570796    0.000000
3  1.0156434  1.015643e+00 0.09876883 0.9012312      0.09  1.5707963 -1.413717    1.413717
4  1.0000000  6.123032e-18 1.10000000 1.1000000      0.90  3.1415927  1.570796    1.570796

终极图表

gg + lapply(split(df, 1:nrow(df)), function(dat) {
  geom_curve(data = dat, aes(x = x, y = y, xend = xend, yend = yend), curvature = dat["curvature"], color = "blue") }
) + xlim(-1,2) + ylim(-1,2) + theme_void()

- symbolrush