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

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)
}

- Henry David Thorough

---

很好的问题。如果没有找到答案，一个可能的解决方法是调整文本的位置。然而，这永远不会完美到100%。我现在正在查看fields包中的arrow.plot。它有一个长度调整选项。 - Rich Scriven

Answer 1

我认为没有内置的解决方案，但如果您可以保证您的点之间距离足够远（否则绘制箭头也将很困难！），那么您可以通过一个假想圆的半径来“缩小”箭头所绘制的点。

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

- Robert Krzyzanowski

Answer 2

我发现当字母靠近时，@RobertKrzyzanowski的答案中一些箭头是反向的，因此我减小了因子。我还使用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)

我并不认为这是一个完整的答案，但或许有用？我认为使用因子而不是绝对减少会在线条接近水平时产生一些缩短，这一点我不太理解。在这个数据中，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)

- IRTFM

---

谢谢！当我开始思考不同字母具有不同的质心时，我的头就开始疼了，我不想考虑所有特殊情况。例如，正如Scriven指出的那样，您也可以尝试移动文本标签以使其适合。最终算法需要某种关于美学包装的知识。也许有人会整理并将其转化为微型包。 - Robert Krzyzanowski

看起来你仍然在段的开头将x值增加15％或长度的5％，并在结尾以相同的比例减少它。y也是如此。 - IRTFM

啊哈！问题在于轴的比例不同，而且位置正在由 x 和 y 更改。我们需要知道典型字母的尺寸，以 x 和 y 坐标为单位，这意味着我们需要知道视口的大小。 - Robert Krzyzanowski

这意味着我们不需要考虑外接圆的半径，而是需要沿着外接椭圆的径向方向的半径。 - Robert Krzyzanowski

已解决！我必须按照上面的讨论规范化视口。 - Robert Krzyzanowski