R：我如何画一条带有多个箭头的线？答案

【问题标题】：R: how do I draw a line with multiple arrows in it?R：我如何画一条带有多个箭头的线？
【发布时间】：2011-08-01 03:19:18
【问题描述】：

我想知道是否有人可以帮助我在 R 中绘制带有多个箭头的线条，如下所示：

--->--->--->--->

提前致谢！

【问题讨论】：

arrows、p.arrows 和 Arrows 都会浮现在脑海中。只有arrows 在基础 R 中，我不记得其他人的包，但应该很容易用 Google 找到。

标签： r plot

【解决方案1】：

基于对原始问题的澄清，我认为应该考虑一般性答案

计算由 (x,y) 点指定的折断曲线的总长度
分割中间段以确保箭头之间的曲线长度相等
注意一些小细节，例如初始“阶段”、终点、箭头后面是否应该有一个细空格等。

下面是一个粗略的尝试。

arrowLine <- function(x, y, N=10, ...){
  lengths <- c(0, sqrt(diff(x)^2 + diff(y)^2))
  l <- cumsum(lengths)
  tl <- l[length(l)]
  el <- seq(0, to=tl, length=N+1)[-1]

  plot(x, y, t="l", ...)

  for(ii in el){

    int <- findInterval(ii, l)
    xx <- x[int:(int+1)]
    yy <- y[int:(int+1)]

    ## points(xx,yy, col="grey", cex=0.5)

    dx <- diff(xx)
    dy <- diff(yy)
    new.length <- ii - l[int]
    segment.length <- lengths[int+1]

    ratio <- new.length / segment.length

    xend <- x[int] + ratio * dx
    yend <- y[int] + ratio * dy
    points(xend,yend, col="white", pch=19)
    arrows(x[int], y[int], xend, yend, length=0.1)

}

}

set.seed(123)
x = sort(c(0, runif(200, 0,2* pi), 2*pi))
y=sin(x)

arrowLine(x, y, N=20)

【讨论】：

【解决方案2】：

有一种偷偷摸摸的方法可以做到这一点，而不必绘制一堆线段或箭头。
以x 和y 开头的数据如上：

plot(x, y, t='l')

然后使用一些固定例程计算从x[1]、y[1] 到x[2]、y[2] 等的局部斜率。将斜率转换为以度为单位的角度，然后（调用斜率向量angslopes）

text(x, y, labels=">", srt=angslopes)  # throws error

抱歉，这行不通，因为据我所知，srt 必须是单个值。所以：

diflen <- length(x)-1
sapply(1:diflen, function(xind) text(x[xind+1], y[xind+1], labels='>', cex=2.5, srt=angslopes[xind]))

在 lattice 包中可能有更简单的方法来做到这一点。

这种方法具有外观优势，允许您通过 par(cex) 指定箭头大小以及颜色 - 这可能与线条颜色不同，甚至沿曲线变化。

【讨论】：

@David 回想起我当时过于仓促的笔记，mang 与angslopes 相同。对不起。

【解决方案3】：

模拟到 DWin 这就是我想出的：

arrowLine <- function(x0,y0,x1,y1,nArrow=1,...)
{
  lines(c(x0,x1),c(y0,y1),...)
  Ax=seq(x0,x1,length=nArrow+1)
    Ay=seq(y0,y1,length=nArrow+1)
  for (i in 1:nArrow)
  {
    arrows(Ax[i],Ay[i],Ax[i+1],Ay[i+1],...)
  }
}

基本上它与一行中的几个箭头重叠，但确实得到了想要的结果（我假设是直线）：

plot(0:1,0:1)
arrowLine(0,0,1,1,4)

真正棘手的部分是让箭头指向点的边缘而不是中心。有必要吗？

【讨论】：

谢谢！这部分起到了作用。但问题是我绘制了多条不同长度的线，因此使用它会在箭头之间创建具有不同间距的线，如下所示：img829.imageshack.us/img829/4746/exampleq.jpg

【解决方案4】：

正如乔兰所说，arrows

 x=cos( seq(0, pi, by=pi/8)  )
 y=sin( seq(0, pi, by=pi/8))
 plot(1,1, ylim=range(y), xlim=range(x))
 arrows(x[-length(x)],y[-length(y)], x[-1],y[-1])

如果你想画一条等长的直线多箭头曲线，那么使用这个函数：

multarrows <- function(x0,y0, x1,y1,n_arr, ...) {x<- seq(x0,x1, length=n_arr+1)
             y<-seq(y0,y1, length=n_arr+1)
             arrows(x[-length(x)],y[-length(y)], x[-1],y[-1], ...) }
plot(0,0, xlim=c(0,2), ylim=c(0,11)); multarrows(0,0, 1,10, 10)

【讨论】：

真的只是画了多个箭头。我希望有一个选项可以让您只绘制一条带有多个箭头的线...
谢谢！您的第二个解决方案部分解决了问题。但问题是我绘制了多条不同长度的线，因此使用它会在箭头之间创建具有不同间距的线，如下所示：img829.imageshack.us/img829/4746/exampleq.jpg。我会试着弄清楚如何解决这个问题，但我在 R 方面没有那么有经验......
第一个解决方案和第二个解决方案的组合应该清楚地表明这是可能的。您只需提供段的开头和结尾，而不是在 hte 函数中拆分行。数据！我们想要数据！（并且链接的图像多次尝试加载失败。）

【解决方案5】：

我想我会在这里添加一个基本的 R 解决方案，将箭头计算为段。有一些版本可以创建新图或向现有图添加箭头。较长的片段被分成较短的片段：

add_arrows <- function(x, y, ...)
{
  # Ensure equal lengthed vectors
  min_len <- min(length(x), length(y))
  x  <- x[seq(min_len)]
  y  <- y[seq(min_len)]

  # Calculate y:x ratio
  yx_ratio <- 3*(max(y) - min(y)) / (max(x) - min(x))

  # Create start and end points
  x1 <- x[-length(x)]
  y1 <- y[-length(y)]
  x2 <- x[-1]
  y2 <- y[-1]

  # Length and angle of line segments
  theta <- atan((y2 - y1)/(x2 - x1))
  seg_lengths <- sqrt((x2 - x1)^2 + (y2 - y1)^2)

  # Break long segments into shorter segments
  long <- which(seg_lengths > (2 * min(seg_lengths)))
  if(length(long) > 0)
  {
    n_segs <- floor(seg_lengths[long] / (1.5 * min(seg_lengths)))

    for(i in seq_along(long))
    {
      xs <- x1[long[i]] + (0:n_segs[i]) * (x2[long[i]] - x1[long[i]]) / n_segs[i]
      ys <- y1[long[i]] + (0:n_segs[i]) * (y2[long[i]] - y1[long[i]]) / n_segs[i]
      x1 <- c(x1, xs[-length(xs)])
      x2 <- c(x2, xs[-1])
      y1 <- c(y1, ys[-length(ys)])
      y2 <- c(y2, ys[-1])
      theta <- c(theta, rep(theta[long[i]], length(xs) - 1))
    }

    x1 <- x1[-long]; x2 <- x2[-long]; y1 <- y1[-long]; y2 <- y2[-long];
    theta <- theta[-long]
  }
  # Arrow head length and width
  len <- sqrt((max(y) - min(y))^2 + (max(x) - min(x))^2)/ 20
  wid <- len * 0.1


  # Calculate arrow heads
  zx  <- x2 - len * cos(theta) * sign(x2 - x1)
  zy  <- y2 - len * sin(theta) * sign(x2 - x1)
  ax1 <- zx + wid * sin(theta) * sign(x2 - x1)
  ax2 <- zx - wid * sin(theta) * sign(x2 - x1)
  ay1 <- zy - wid * cos(theta) * sign(x2 - x1) * yx_ratio
  ay2 <- zy + wid * cos(theta) * sign(x2 - x1) * yx_ratio

  df <- data.frame(x1  = x1 + 0.1 * (x2 - x1),
                   y1  = y1 + 0.1 * (y2 - y1),
                   x2  = x2 - 0.5 * len * cos(theta) * sign(x2 - x1),
                   y2  = y2 - 0.5 * len * sin(theta) * sign(x2 - x1),
                   ax1 = ax1, ay1 = ay1, ax2 = ax2, ay2 = ay2)

  # Draw segments
  segments(df$x1, df$y1, df$x2,  df$y2,  col = "red", lwd = 2)
  segments(df$x2, df$y2, df$ax1, df$ay1, col = "red", lwd = 2)
  segments(df$x2, df$y2, df$ax2, df$ay2, col = "red", lwd = 2)
}

这允许您绘制箭头作为绘图的基础：


plot_arrows <- function(x, y, ...)
{
  plot(x, y, col = "white", ...)
  add_arrows(x, y, ...)
}

所以现在你可以这样做了：

set.seed(69)

x <- 1:10
y <- sample(10)
plot(x, y)
add_arrows(x, y)

^{由reprex package (v0.3.0) 于 2020 年 2 月 29 日创建}

【讨论】：