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

Question

我使用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])

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

更新

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

Answer 1

我不认为有一个内置的解决方案，但是如果你可以保证你的点间距足够远（无论如何绘制箭头都很困难！）那么你可以＆＃34;收缩＆＃34 ;箭头所绘制的点是每个字母外围的假想圆的半径长度。

但请注意，由于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)

Answer 2

我看到有些箭头在@ RobertKrzyzanowski的答案中被反转，当字母接近时，我减少了因素。我还使用hte diff（）函数对函数进行了矢量化：

 plot(x,y, main = "Stack Example", type = 'n')
 text(x = x, y = y, LETTERS[1:length(x)], cex = 2)
 gap_arrows <- function(x, fact = 0.075) {
      dist <- sqrt( diff(x)^2 + diff(y)^2)
      x0 <- x[-length(x)] + (tmp <- fact * (diff(x)) / dist)
      x1 <- x[-1] - tmp
      y0 <- y[-length(y)] + (tmp <- fact * diff(y) / dist)
      y1 <- y[-1] - tmp
      arrows(x0,y0,x1,y1)
    }

 gap_arrows2(x)

我真的不认为这是一个完整的答案，但也许有用吗？我认为使用因子ratehr而不是绝对减少会在线条接近水平时产生一些缩短，我不明白。这个数据中的G-G转换似乎很奇怪（太短）：

> dput(x)
c(0.058478488586843, 0.152887222822756, 0.171698493883014, 0.197744736680761, 
0.260856857057661, 0.397151953307912, 0.54208036721684, 0.546826156554744, 
0.633055359823629, 0.662317642010748, 0.803418542025611, 0.83192756283097
)
> dput(y)
c(-0.256092192198247, -0.961856634130129, 0.0412329219929399, 
0.235386572284857, 1.84386200523221, -0.651949901695459, -0.490557443700668, 
1.44455085842335, -0.422496832339625, 0.451504053079215, -0.0713080861235987, 
0.0779608495637108)