logo标签列表

如何在一条线上绘制多个箭头？

rplot
4
我想知道是否有人可以帮我在R中绘制多个箭头的线条，就像这样：
--->--->--->--->
谢谢！
我想到了“arrows”、“p.arrows”和“Arrows”。只有“arrows”是在基本R中的，我不记得其他的包名，但是可以通过谷歌轻松找到。 - joran
5个回答
9
根据对原问题的澄清，我认为一般性答案应考虑：

  • 计算由(x,y)点指定的断裂曲线的总长度

  • 分开中间段，以确保箭头之间的等曲线长度

  • 处理细节，如初始“相位”，端点，箭头后是否应跟随一个细空格等。

arrows

以下是一个粗略的尝试。

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

有一种巧妙的方法可以在不绘制一堆线段或箭头的情况下完成这个操作。
从上面的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 是相同的。抱歉。 - Carl Witthoft
2

正如joran所说，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)

enter image description here

那只是画多个箭头。我希望有一个选项，可以在一条线上画出多个箭头... - Abdel
谢谢！你的第二个解决方案部分地解决了问题。但问题在于我要画多条不同长度的线，所以使用这种方法会导致箭头之间的间距不同，就像这样：http://img829.imageshack.us/img829/4746/exampleq.jpg。我会尝试找出如何解决这个问题，但我在R方面经验不是很丰富... - Abdel
第一种解决方案和第二种解决方案的组合应该表明这是可能的。您只需要提供段落的开头和结尾，而不是在函数内部拆分行。数据！我们想要数据！（链接图像多次尝试加载失败。） - IRTFM
2
类似于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)

一条线上有多个箭头

真正棘手的部分是让箭头到达点的边缘而不是中心。这是必需的吗？

谢谢！这部分已经解决了问题。但是问题在于我要画多条不同长度的线，所以使用这种方法会导致箭头之间的间距不同，就像这样：http://img829.imageshack.us/img829/4746/exampleq.jpg - Abdel
2
我认为在这里添加一个基本的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)

创建于2020年2月29日，使用reprex包（v0.3.0）

网页内容由stack overflow 提供, 点击上面的
可以查看英文原文，
原文链接