我已经找到了解决这个问题的方法。它很大而笨重,但是有效。
核心问题是
geom_curve()
不会绘制一个固定的路径,而是随着绘图窗口的纵横比例进行移动和缩放。因此,除了使用
coord_fixed(ratio=1)
锁定纵横比例之外,我很难预测
geom_curve()
段的中点位置。
![Plot exported at height = 2, width = 4, same points plotted](https://istack.dev59.com/ShzXc.webp)
因此,我开始寻找曲线的中点,然后强制曲线通过这个点,之后我会给它贴标签。为了找到中点,我不得不从
grid package中复制两个函数。
library(grid)
library(tidyverse)
library(ggrepel)
calcControlPoints <- function(x1, y1, x2, y2, curvature, angle, ncp,
debug=FALSE) {
xm <- (x1 + x2)/2
ym <- (y1 + y2)/2
dx <- x2 - x1
dy <- y2 - y1
slope <- dy/dx
if (is.null(angle)) {
angle <- ifelse(slope < 0,
2*atan(abs(slope)),
2*atan(1/slope))
} else {
angle <- angle/180*pi
}
sina <- sin(angle)
cosa <- cos(angle)
cornerx <- xm + (x1 - xm)*cosa - (y1 - ym)*sina
cornery <- ym + (y1 - ym)*cosa + (x1 - xm)*sina
if (debug) {
grid.points(cornerx, cornery, default.units="inches",
pch=16, size=unit(3, "mm"),
gp=gpar(col="grey"))
}
beta <- -atan((cornery - y1)/(cornerx - x1))
sinb <- sin(beta)
cosb <- cos(beta)
newx2 <- x1 + dx*cosb - dy*sinb
newy2 <- y1 + dy*cosb + dx*sinb
scalex <- (newy2 - y1)/(newx2 - x1)
newx1 <- x1*scalex
newx2 <- newx2*scalex
ratio <- 2*(sin(atan(curvature))^2)
origin <- curvature - curvature/ratio
if (curvature > 0)
hand <- "right"
else
hand <- "left"
oxy <- calcOrigin(newx1, y1, newx2, newy2, origin, hand)
ox <- oxy$x
oy <- oxy$y
dir <- switch(hand,
left=-1,
right=1)
maxtheta <- pi + sign(origin*dir)*2*atan(abs(origin))
theta <- seq(0, dir*maxtheta,
dir*maxtheta/(ncp + 1))[c(-1, -(ncp + 2))]
costheta <- cos(theta)
sintheta <- sin(theta)
cpx <- ox + ((newx1 - ox) %*% t(costheta)) -
((y1 - oy) %*% t(sintheta))
cpy <- oy + ((y1 - oy) %*% t(costheta)) +
((newx1 - ox) %*% t(sintheta))
cpx <- cpx/scalex
sinnb <- sin(-beta)
cosnb <- cos(-beta)
finalcpx <- x1 + (cpx - x1)*cosnb - (cpy - y1)*sinnb
finalcpy <- y1 + (cpy - y1)*cosnb + (cpx - x1)*sinnb
if (debug) {
ox <- ox/scalex
fox <- x1 + (ox - x1)*cosnb - (oy - y1)*sinnb
foy <- y1 + (oy - y1)*cosnb + (ox - x1)*sinnb
grid.points(fox, foy, default.units="inches",
pch=16, size=unit(1, "mm"),
gp=gpar(col="grey"))
grid.circle(fox, foy, sqrt((ox - x1)^2 + (oy - y1)^2),
default.units="inches",
gp=gpar(col="grey"))
}
list(x=as.numeric(t(finalcpx)), y=as.numeric(t(finalcpy)))
}
calcOrigin <- function(x1, y1, x2, y2, origin, hand) {
xm <- (x1 + x2)/2
ym <- (y1 + y2)/2
dx <- x2 - x1
dy <- y2 - y1
slope <- dy/dx
oslope <- -1/slope
tmpox <- ifelse(!is.finite(slope),
xm,
ifelse(!is.finite(oslope),
xm + origin*(x2 - x1)/2,
xm + origin*(x2 - x1)/2))
tmpoy <- ifelse(!is.finite(slope),
ym + origin*(y2 - y1)/2,
ifelse(!is.finite(oslope),
ym,
ym + origin*(y2 - y1)/2))
sintheta <- -1
ox <- xm - (tmpoy - ym)*sintheta
oy <- ym + (tmpox - xm)*sintheta
list(x=ox, y=oy)
}
有了那个条件,我计算了每个记录的中点。
df <- data.frame(x1 = 1, y1 = 1, x2 = 10, y2 = 10, details = "Object Name")
df_mid <- df
mutate(midx = calcControlPoints(x1, y1, x2, y2,
angle = 130,
curvature = 0.5,
ncp = 1)$x)
mutate(midy = calcControlPoints(x1, y1, x2, y2,
angle = 130,
curvature = 0.5,
ncp = 1)$y)
我接着画出这张图,但是绘制了两条分开的曲线。一条从原点到计算出的中点,另一条从中点到目的地。找到中点和绘制这些曲线的角度和曲率设置很棘手,以确保结果不明显看起来像两个不同的曲线。
ggplot(df_mid, aes(x = x1, y = y1)) +
geom_point(size = 4) +
geom_point(aes(x = x2, y = y2),
pch = 17, size = 4) +
geom_curve(aes(x = x1, y = y1, xend = midx, yend = midy),
curvature = 0.25, angle = 135) +
geom_curve(aes(x = midx, y = midy, xend = x2, yend = y2),
curvature = 0.25, angle = 45) +
geom_label_repel(aes(x = midx, y = midy, label = details),
box.padding = 4,
nudge_x = 0.5,
nudge_y = -2)
![Final plot with label tied to invisible midpoint](https://istack.dev59.com/S2CwL.webp)
尽管答案并不理想或优雅,但它可以适用于大量记录。