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

Question

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

这个功能有2个问题..

问题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)

创建以下图：

问题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)

我得到以下情节：

以下错误消息：

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]

关于如何解决这些问题的任何想法？非常感谢提前！

Answer 1

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

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

此解决方案中的箭头仍有不同的颜色。为避免这种情况，只需移除ifelse中的arrows col=second.col

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

以下行应该这样做：

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

在'color.scale.arrow'

中的'invisible'命令之前添加它

Answer 2

这是一种与我认为你想要的不同的方法：

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)

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