0

我在 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]

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

4

2 回答 2

1

这是一种不同的方法，可以满足我的要求：

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)

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

于 2013-12-06T17:28:34.357 回答
1

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

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

在此解决方案中，箭头仍然具有不同的颜色。为避免这种情况，只需删除ifelsein arrowsbycol=second.col

第一次尝试 [11:05] 见 Abdel 的评论 ------------

以下行应该这样做：

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

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

于 2013-12-06T11:05:07.203 回答