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)
 "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: 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))
 "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?