Black Lives Matter. Please consider donating to Black Girls Code today.

How to set colorscale in surface plot using R?

I want to use a custom colorscale for a surface plot. I was given a x,y TIFF image with a color bar representing height. I’m trying to reverse engineer the colorscale to back out the heights. I created a function that replicates the color bar fairly well which has allowed me to map the x,y positions to a height. When I plot the surface using the basic example it chooses a color mapping for me. I would like to display it with the original color mapping.

I tried using the examples here and here.

On the basis of this, I figure I could pass a function to colors:

> colors = colorRamp(c("green", "blue", "red"))
> class(colors)
[1] "function"
> sapply(seq(0,1,0.05), colors)
     [,1]  [,2] [,3]  [,4] [,5]  [,6] [,7]  [,8] [,9] [,10] [,11] [,12] [,13] [,14] [,15]
[1,]    0   0.0    0   0.0    0   0.0    0   0.0    0   0.0     0  25.5    51  76.5   102
[2,]  255 229.5  204 178.5  153 127.5  102  76.5   51  25.5     0   0.0     0   0.0     0
[3,]    0  25.5   51  76.5  102 127.5  153 178.5  204 229.5   255 229.5   204 178.5   153
     [,16] [,17] [,18] [,19] [,20] [,21]
[1,] 127.5   153 178.5   204 229.5   255
[2,]   0.0     0   0.0     0   0.0     0
[3,] 127.5   102  76.5    51  25.5     0
plot_ly(z = ~val_matrix, colors=colors) %>% add_surface()

So I tried my own function:

getR = function(x)
{
  if (0<=x & x <=1/3)
  {
    R = 1
  } else if (x>1/3 & x<=1/2)
  {
    R = 1 - 6*(x - 1/3)
  } else
  {
    R = 0
  }
}

getG = function(x)
{
  if (0<=x & x<=1/6)
  {
    G = 1 - 6*x
  } else if (1/6<x & x<=1/3)
  {
    G = -1 + 6*(x)
  } else if (1/3<x & x<=2/3)
  {
    G = 1
  } else if (2/3<x & x<=5/6)
  {
    G = 1 - 6*(x - 2/3)
  } else
  {
    G = 0
  }
}

getB = function(x)
{
  if (0<=x & x<=1/6)
  {
    B = 1 - 6*x
  } else if (1/6<x & x<=1/2)
  {
    B = 0
  } else if (1/2<x & x<=2/3)
  {
    B = -3 + 6*x
  } else if (2/3<x & x <=5/6)
  {
    B = 1
  } else
  {
    B = 1 - 6*(x - 5/6)
  }
}


x = seq(0,1,2^-10)

cmap = data.frame(
  r=sapply(x, getR),
  g=sapply(x, getG),
  b=sapply(x, getB)
)

ggplot(cmap, aes(x=x)) + 
  geom_line(aes(y=r), col='red') + 
  geom_line(aes(y=g), color='green') + 
  geom_line(aes(y=b), color='blue')

Which gives:

Rplot

So, I tried

getColor = function(x)
{
  r = getR(x)*255
  g = getG(x)*255
  b = getB(x)*255
  return( as.matrix(c(r,g,b), nrow=1, ncol=3) )
}
> sapply(seq(0,1,0.02), getColor)
     [,1]  [,2]  [,3]  [,4]  [,5] [,6]  [,7]  [,8]  [,9] [,10] [,11] [,12] [,13] [,14] [,15]
[1,]  255 255.0 255.0 255.0 255.0  255 255.0 255.0 255.0 255.0   255 255.0 255.0 255.0 255.0
[2,]  255 224.4 193.8 163.2 132.6  102  71.4  40.8  10.2  20.4    51  81.6 112.2 142.8 173.4
[3,]  255 224.4 193.8 163.2 132.6  102  71.4  40.8  10.2   0.0     0   0.0   0.0   0.0   0.0
     [,16] [,17] [,18] [,19] [,20] [,21] [,22] [,23] [,24] [,25] [,26] [,27] [,28] [,29]
[1,]   255 255.0 244.8 214.2 183.6   153 122.4  91.8  61.2  30.6     0   0.0   0.0   0.0
[2,]   204 234.6 255.0 255.0 255.0   255 255.0 255.0 255.0 255.0   255 255.0 255.0 255.0
[3,]     0   0.0   0.0   0.0   0.0     0   0.0   0.0   0.0   0.0     0  30.6  61.2  91.8
     [,30] [,31] [,32] [,33] [,34] [,35] [,36] [,37] [,38] [,39] [,40] [,41] [,42] [,43]
[1,]   0.0     0   0.0   0.0   0.0   0.0     0   0.0   0.0   0.0   0.0     0   0.0   0.0
[2,] 255.0   255 255.0 255.0 255.0 234.6   204 173.4 142.8 112.2  81.6    51  20.4   0.0
[3,] 122.4   153 183.6 214.2 244.8 255.0   255 255.0 255.0 255.0 255.0   255 255.0 244.8
     [,44] [,45] [,46] [,47] [,48] [,49] [,50]        [,51]
[1,]   0.0   0.0     0   0.0   0.0   0.0   0.0 0.000000e+00
[2,]   0.0   0.0     0   0.0   0.0   0.0   0.0 0.000000e+00
[3,] 214.2 183.6   153 122.4  91.8  61.2  30.6 5.662137e-14
> print(class(getColor))
[1] "function"
> plot_ly(z = ~val_matrix, colors=getColor) %>% add_surface()
Error in grDevices::rgb(results, maxColorValue = 255) : 
  at least 3 columns needed

I also tried switching nrow and ncol and get the same error.

best for the #api:r forums

Thanks @etienne. Can I move it, or should I repost?