R: help needed improving a function for changing arrow colours from starting point to end point

Question

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

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..

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:

# 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:

# 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!

Answer 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.