3

I'm trying to make an image similar to this one by OpenWetWare (source). I generate the curves using the colourvision package. I made the color spectrum with the rainbow() palette, based on code by @baptiste found here (and repeated here).

enter image description here

Problem and question The gradient I produced does not correspond to the actual color frequencies. How can I generate a spectrum that coincides (at least closely) with the actual color frequencies (e.g., 550 nm in green-yellow territory, not cyan). I'm certain rainbow() is probably not the way to generate the needed palette but I do not know what would be the best way.

MWE

library(colourvision)
library(ggplot2)
library(grid)

gradient <- t(rev(rainbow(20))) # higher value for smoother gradient
g <- rasterGrob(gradient, width = unit(1, "npc"), height = unit(1, "npc"), interpolate = TRUE) 

human <- photor(lambda.max = c(420, 530, 560), lambda = seq(400, 700, 1))

ggplot(data = human, aes(x = Wavelength)) +
  annotation_custom(g, xmin = -Inf, xmax = Inf, ymin = -Inf, ymax = Inf) +
  geom_line(aes(y = lambda.max420), color = "white") +
  geom_line(aes(y = lambda.max530), color = "white") +
  geom_line(aes(y = lambda.max560), color = "white") +
  scale_x_continuous(breaks = seq(400, 700, 50)) +
  labs(x = NULL, y = NULL) # Save space for question

Result

enter image description here

Michael S Taylor
  • 425
  • 5
  • 16
  • 1
    Have a look at `w_length2rgb` in the `photobiology` package. – Andrew Gustar Oct 16 '19 at 16:02
  • In general: it is better to avoid using colour in such figures: it gives a wrong idea on colours. Remember that one colour could be seen as an other, depending eye adaptation. See the 'note' of their master when his saw colours, as copied and explained in Giorgianni & Madden – Giacomo Catenazzi Oct 17 '19 at 13:45
  • @GiacomoCatenazzi In general, I agree. I need it for a specific purpose, though. – Michael S Taylor Oct 17 '19 at 15:56

1 Answers1

3

You could use w_length2rgb from the photobiology package:

library(photobiology)

gradient <- t(w_length2rgb(400:700))

#then the rest of your code as it is

enter image description here

Following your comment, and just for completeness, you could also use the data from cvrl.org, which I think looks better...

conesdata <- read.csv("http://www.cvrl.org/database/data/cones/linss10e_5.csv")
names(conesdata) <- c("Wavelength", "Red", "Green", "Blue")
conesdata[is.na(conesdata)] <- 0
conesdata$colour <- rgb(conesdata$Red, conesdata$Green, conesdata$Blue)   
gradient <- t(conesdata$colour[conesdata$Wavelength >= 400 & conesdata$Wavelength <= 700])

#then the rest of your code as before

enter image description here

Andrew Gustar
  • 17,295
  • 1
  • 22
  • 32
  • Your solution got me close. I played with the chromaticity model and the color range to get very close so that the rightmost peak is actually in yellow, like the original. It would be great if the left end of the spectrum included "violet" colors but it seems `w_length2rgb` is simulating the spectrum visible to humans and so fades to black. Do you know of a way to generate the broader spectrum? Thanks for your time. – Michael S Taylor Oct 16 '19 at 20:02
  • I don't know of any other standard packages to do this, although, if you know the expected wavelength-colour values at a few points it would not be too difficult to write a function to stretch a spectrum produced with `rainbow` - perhaps using the `approx` function to interpolate. – Andrew Gustar Oct 16 '19 at 21:45
  • 1
    I got very close to my desired result using data from http://www.cvrl.org/cones.htm instead of `colourvision` to make the curves, in combination with your solution. – Michael S Taylor Oct 17 '19 at 16:07
  • 1
    @MichaelSTaylor Great! For completeness, I have updated the answer with a version based on the colour data from cvrl.org. Not entirely sure whether I have used the right dataset, but it produces a nicer gradient! – Andrew Gustar Oct 17 '19 at 16:27
  • 1
    The new gradient is much nicer. You did you the same dataset I chose. Thank you! – Michael S Taylor Oct 18 '19 at 12:37