用另一条具有相同位置但使用“geom_curve”在“ggplot2”中切割开头和结尾的曲线重叠绘制曲线

我有一个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)
)

我可以用单独的曲线绘制这些曲线curvature论据（想法来自here https://stackoverflow.com/questions/55627528/how-can-i-pass-individual-curvature-arguments-in-ggplot2-geom-curve-functi):

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 https://stackoverflow.com/questions/55686910/how-can-i-access-dimensions-of-labels-plotted-by-geom-text-in-ggplot2).

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

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

像这样我可以切割曲线的起点和终点。但正如我们所看到的red曲线与原始曲线不相符black那些很好。

我怎样才能提高我的offset and recalculate_points函数为了red曲线拟合black curves better?

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

注意：我不需要 100% 适合。但视觉上的贴合度应该有所改善。所以我的预期输出应该类似于:

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

开始了：

1. 计算angles所有曲线的所有起点和终点；
2. 找出vectors给定长度，从起点和终点开始，并且具有angles从点 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()