我用箭头从一组点到另一组arrows().我想将箭头缩短一个共同的长度,以便它们不与标签重叠.然而,考虑到arrows()将坐标作为输入,人们如何做到这一点并不明显.
例如,这是一个例子.
x <- stats::runif(12); y <- stats::rnorm(12)
i <- order(x, y); x <- x[i]; y <- y[i]
plot(x,y, main = "Stack Example", type = 'n')
text(x = x, y = y, LETTERS[1:length(x)], cex = 2, col = sample(colors(), 12))
s <- seq(length(x)-1) # one shorter than data
arrows(x[s], y[s], x[s+1], y[s+1])
Run Code Online (Sandbox Code Playgroud)
如何缩短箭头以使它们不与标签重叠?
这些都是很好的答案.为了想出一些不会假设点在链中连接的东西,我写了下面的函数,它将x0y0(第1列为x,第2列为y的数据帧)移近xy(格式与x0y0)绝对距离d.
movePoints <- function(x0y0, xy, d){
total.dist <- apply(cbind(x0y0, xy), 1,
function(x) stats::dist(rbind(x[1:2], x[3:4])))
p <- d / total.dist
p <- 1 - p
x0y0[,1] <- xy[,1] + p*(x0y0[,1] - xy[,1])
x0y0[,2] <- xy[,2] + p*(x0y0[,2] - xy[,2])
return(x0y0)
}
Run Code Online (Sandbox Code Playgroud)
我不认为有一个内置的解决方案,但如果你可以保证你的点间距足够远(无论如何绘制箭头都很困难!)那么你可以"收缩"箭头所绘制的点.每个字母外围的假想圆的半径长度.
但是请注意,由于x轴和y轴的比例不同,我们在转换之前必须小心标准化x和y值.reduce_length下面的参数是%典型字母占据的总视口的估计值.如果你想在字母周围留出更多空间,你可以调整它.另外要注意不要选择使字母不可见的不良颜色.
最后,缺陷是由于不同字母的不同尺寸.要真正解决这个问题,我们需要一个字母到微观x和y调整的地图.
x <- stats::runif(12); y <- stats::rnorm(12)
i <- order(x, y); x <- x[i]; y <- y[i]
initx <- x; inity <- y
plot(x,y, main = "Stack Example", type = 'n')
text(x = x, y = y, LETTERS[1:length(x)], cex = 2, col = sample(colors()[13:100], 12))
spaced_arrows <- function(x, y, reduce_length = 0.048) {
s <- seq(length(x)-1) # one shorter than data
xscale <- max(x) - min(x)
yscale <- max(y) - min(y)
x <- x / xscale
y <- y / yscale
# shrink the line around its midpoint, normalizing for differences
# in scale of x and y
lapply(s, function(i) {
dist <- sqrt((x[i+1] - x[i])^2 + (y[i+1] - y[i])^2)
# calculate our normalized unit vector, accounting for scale
# differences in x and y
tmp <- reduce_length * (x[i+1] - x[i]) / dist
x[i] <- x[i] + tmp
x[i+1] <- x[i+1] - tmp
tmp <- reduce_length * (y[i+1] - y[i]) / dist
y[i] <- y[i] + tmp
y[i+1] <- y[i+1] - tmp
newdist <- sqrt((x[i+1] - x[i])^2 + (y[i+1] - y[i])^2)
if (newdist > reduce_length * 1.5) # don't show too short arrows
# we have to rescale back to the original dimensions
arrows(xscale*x[i], yscale*y[i], xscale*x[i+1], yscale*y[i+1])
})
TRUE
}
spaced_arrows(x, y)
Run Code Online (Sandbox Code Playgroud)
