R：帮助需要改进从起点到终点改变箭头颜色的功能

I have the following function in R that draws arrows changing colours:

我在R中有以下函数绘制箭头改变颜色：

require(plotrix)

color.scale.arrow = function(x1,y1,x2,y2,first.col,second.col,
lwd= par('lwd'),lty=par('lty'),angle=30,length=0.25) {
    x=mapply(seq,x1,x2,length.out=256) # Each column is one arrow
    y=mapply(seq,y1,y2,length.out=256) # Each column is one arrow

    arrows(x[255,],y[255,],x[256,],y[256,],
           col=ifelse(y[256,]<y[255,],first.col,second.col),
           lwd=lwd,lty=lty,angle=angle,length=length)

    rgb1=col2rgb(first.col)[,1] / 255
    rgb2=col2rgb(second.col)[,1] / 255
    cols=rbind(rgb1,(rgb1 + rgb2) / 2,rgb2)

    invisible(
          sapply(seq(ncol(x)),function(line) 
              color.scale.lines(x[,line],y[,line],
              cols[,'red'],cols[,'green'],cols[,'blue'],
              lwd=lwd,lty=lty)
          )
   )
}

I have 2 problems with this function..

我有这个功能的2个问题..

Problem 1: The arrows start out as red and end as blue if they move upwards, and start out as blue and end in red if they move downwards. I actually need the arrows to always start out as blue, and always end in red. The problem is illustrated with this simplified example data:

问题1：箭头以红色开始，如果向上移动则以蓝色结束，从蓝色开始，如果向下移动则以红色结束。我实际上需要箭头总是以蓝色开始，并且总是以红色结束。这个简化的示例数据说明了这个问题：

# Create sample data 1
x <- c(5,6,5,6)
y <- c(3,5,5,4)

x1 <- c(5,5)
y1 <- c(3,5)
x2 <- c(6,6)
y2 <- c(5,4)

# Plot sample data 1
plot(x,y, main='')
color.scale.arrow(x1,y1,x2,y2,'red','blue',lwd=2)

Which creates the following plot:

这创建了以下图：

Problem 2: The script only allows for arrows going from left to right. When trying to draw arrows in the other direction, I get an error message. For example, when plotting this example data:

问题2：脚本只允许箭头从左到右。当试图向另一个方向绘制箭头时，我收到一条错误消息。例如，在绘制此示例数据时：

# Create sample data 2
x <- c(1,3,5,3,2,1,6,2)
y <- c(2,5,3,7,2,1,5,6)

x1 <- c(1,3,5,3)
y1 <- c(2,5,3,7)
x2 <- c(2,1,6,2)
y2 <- c(2,1,5,6)

# Plot sample data 2
plot(x,y, main='')
color.scale.arrow(x1,y1,x2,y2,'red','blue',lwd=2)

I get the following plot:

我得到以下情节：

And the following error message:

并出现以下错误消息：

Error in rgb(c(2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2,  : color intensity 2, not in [0,1]

Any idea on how to solve these problems? Many thanks in advance!

有关如何解决这些问题的任何想法？提前谢谢了！

2 个解决方案

#1

Here is a little different approach that does what I think you want:

这是一个有点不同的方法，可以满足我的想法：

csa <- function(x1,y1,x2,y2,first.col,second.col, ...) {
    cols <- colorRampPalette( c(first.col,second.col) )(250)
    x <- approx(c(0,1),c(x1,x2), xout=seq(0,1,length.out=251))$y
    y <- approx(c(0,1),c(y1,y2), xout=seq(0,1,length.out=251))$y

    arrows(x[250],y[250],x[251],y[251], col=cols[250], ...)
    segments(x[-251],y[-251],x[-1],y[-1],col=cols, ...)

}


color.scale.arrow <- Vectorize(csa, c('x1','y1','x2','y2') )

# Create sample data 2
x <- c(1,3,5,3,2,1,6,2)
y <- c(2,5,3,7,2,1,5,6)

x1 <- c(1,3,5,3)
y1 <- c(2,5,3,7)
x2 <- c(2,1,6,2)
y2 <- c(2,1,5,6)

# Plot sample data 2
plot(x,y, main='')
color.scale.arrow(x1,y1,x2,y2,'red','blue',lwd=2)

This at least works for the example data, tweaks are possible for other options.

这至少适用于示例数据，可以对其他选项进行调整。

#2

second try [18:15] ----------------------

第二次尝试[18:15] ----------------------

add colvar=seq(0,1,len=255) inside your local function inside the sapply statement (same level as the lwd and lty argument). IMHO the definition colors.scale.lines is not valid, except you use the colvar argument explicitly.

在sapply语句中的本地函数内添加colvar = seq（0,1，len = 255）（与lwd和lty参数相同）。 IMHO定义colors.scale.lines无效，除非您明确使用colvar参数。

The arrowheads have still different colors in this solution. To avoid this just remove the ifelse in arrows by col=second.col

箭头在此解决方案中仍具有不同的颜色。要避免这种情况，只需通过col = second.col删除箭头中的ifelse即可

first try [11:05] see comment of Abdel ------------

首先尝试[11:05]看看Abdel的评论------------

The following line should do it:

以下行应该这样做：

if((x[1]-x[2])/(y[1]-y[2]) < 0) cols <- cols[nrow(cols):1,]

Add it before the 'invisible' command in 'color.scale.arrow'

在'color.scale.arrow'中的'invisible'命令之前添加它