Overplot curve by another curve with the same position but cutted beginning and end in `ggplot2` using `geom_curve`

Question

I have a df with curve informations:

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

I can plot those curves with individual curvature arguments (idea from 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()

Now I want to overplot that image with the same curves, but each curve should be cutted at the beginning and the end for about 10%.

First I thought I might be able to use the information from my gg object but could not see where ggplot2 stores the information (see also my question here).

Then I tried rescaling the start and end points using:

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

Like this I can cut the beginning and end of my curves. But as we can see the red curves don't fit the original black ones well.

How can I improve my offset and recalculate_points functions in order the red curves fit the black curves better?

Or even better: where can I find the curve information in the gg object and how can I use that information to rescale my curves?

Note: I don't need a 100% fit. But the fit should be visually improved. So my expected output should look for example like:

Are you trying to [add shadows](https://stackoverflow.com/q/49861489/680068)? — zx8754, Apr 15 '19 at 12:23
@zx8754: No. I'm trying to cut arrows in order they don't overplot labels. Imagine labels at every point the curves meet. I initially thought there is an option inside `geom_curve` or a `geom` that fits my needs better and posted [this](https://stackoverflow.com/questions/55632173/how-can-i-cut-curves-drawn-by-geom-curve-in-order-they-dont-overlap-labels-pl) question. As it seems there is no easy solution I refined the question to be more specific on the curve cutting part. — symbolrush, Apr 15 '19 at 12:32
Why not plot the labels last: `... + geom_label(aes(x, y, label = curvature))`, i.e. plotting on top connection points. — zx8754, Apr 15 '19 at 13:10
@zx8754: Thx for your hint. Sadly this doesn't really help, because the labels would overplot the arrow heads and because the labels shall not have a black line around them (as it is with `geom_label`). — symbolrush, Apr 15 '19 at 13:15
I understand the requirement, just trying to cut corners :) Yeah, arrows won't work with boxed labels. — zx8754, Apr 15 '19 at 13:16

score 1 · Answer 1 · answered Apr 16 '19 at 04:59

I found a first solution. It is a bit complicated, but seems to work. Improvements and alternatives are still very welcome!

Here we go:

calculate the angles of all start and end points of all curves;
find the vectors of a given length that start at the start and end points and have the angles from point 1;
recalculate x, xend, y, yend to fit the curves;
recalculate the curvature argument (it needs to be a bit smaller)

In detail and with code:

Step 0: Initialization and default plot

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

Step 1: Angles

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

Steps 2 - 4: Angles, Vectors, recalculated points and curvature

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

Final plot

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

Overplot curve by another curve with the same position but cutted beginning and end in `ggplot2` using `geom_curve`

1 Answers1

Linked