r - 使用 `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)
)

我可以使用单独的曲率参数绘制这些曲线(来自 here 的想法):

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% 适合。但视觉上的贴合度应该有所改善。所以我的预期输出应该类似于:

Answer 1

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

<小时/>

我们开始:

1. 计算所有曲线的所有起点和终点的角度；
2. 查找从起点和终点开始且具有从点 1 开始的角度的给定长度的向量；
3. 重新计算x、xend、y、yend以拟合曲线；
4. 重新计算曲率参数(它需要小一点)

<小时/>

详细信息和代码:

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