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