缩短坐标之间的箭头/线/段

Hen*_*ugh 3 plot r

我用箭头从一组点到另一组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)

如何缩短箭头以使它们不与标签重叠?

UPDATE

这些都是很好的答案.为了想出一些不会假设点在链中连接的东西,我写了下面的函数,它将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)

Rob*_*ski 5

我不认为有一个内置的解决方案,但如果你可以保证你的点间距足够远(无论如何绘制箭头都很困难!)那么你可以"收缩"箭头所绘制的点.每个字母外围的假想圆的半径长度.

但是请注意,由于x轴和y轴的比例不同,我们在转换之前必须小心标准化x和y值.reduce_length下面的参数是%典型字母占据的总视口的估计值.如果你想在字母周围留出更多空间,你可以调整它.另外要注意不要选择使字母不可见的不良颜色.

最后,缺陷是由于不同字母的不同尺寸.要真正解决这个问题,我们需要一个字母到微观xy调整的地图.

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)

在此输入图像描述 在此输入图像描述 在此输入图像描述 在此输入图像描述 在此输入图像描述