Gradient fill area under curve-CodePudding

I want to fill the area under curve with the optical spectrum colors, getting a plot like this.

This is what I tried

 ggplot(bq, aes(x=w.length, y=s.e.irrad))  
  geom_segment(aes(xend=w.length, yend=0, colour=abs(w.length)^0.7*sign(w.length)))  
  geom_line()  
  scale_colour_gradient2(low=scales::muted("blue"), 
                         mid=scales::muted("green"), 
                         high=scales::muted("red"))

getting this

Also tried with geom_area

ggplot(bq, aes(x = w.length, y = s.e.irrad)) 
  geom_area(fill = "steelblue") #steelblue is for example

But can't fill with gradient

My dataframe has wavelengths in x and Irradiance in y

CodePudding user response：

The following should be close to what you're looking for. The trick is to use scale_color_identity for the geom_segment, and passing to the color aesthetic an RGB string that represents each wavelength in your data frame.

ggplot(bq, aes(x=w.length, y=s.e.irrad))  
  geom_segment(aes(xend=w.length, yend=0, colour = nm_to_RGB(w.length)),
               size = 1)  
  geom_line()  
  scale_colour_identity()

Or if you want a more muted appearance:

ggplot(bq, aes(x=w.length, y=s.e.irrad))  
  geom_area(fill = "black")  
  geom_segment(aes(xend=w.length, yend=0, 
                   colour = nm_to_RGB(w.length)),
               size = 1, alpha = 0.3)  
  geom_line()  
  scale_colour_identity()

The only drawback being that you need to define nm_to_RGB: the function that converts a wavelength of light into a hex-string to represent a color. I'm not sure there's a "right" way to do this, but one possible implementation (that I translated from the javascript function here) would be:

nm_to_RGB <- function(wavelengths){
  sapply(wavelengths, function(wavelength) {
  red <- green <- blue <- 0  
  if((wavelength >= 380) & (wavelength < 440)){
    red <- -(wavelength - 440) / (440 - 380)
    blue <- 1
  }else if((wavelength >= 440) & (wavelength<490)){
    green <- (wavelength - 440) / (490 - 440)
    blue <- 1
  }else if((wavelength >= 490) && (wavelength<510)){
    green <- 1
    blue = -(wavelength - 510) / (510 - 490)
  }else if((wavelength >= 510) && (wavelength<580)){
    red = (wavelength - 510) / (580 - 510)
    green <- 1
  }else if((wavelength >= 580) && (wavelength<645)){
    red = 1
    green <- -(wavelength - 645) / (645 - 580)
  }else if((wavelength >= 645) && (wavelength<781)){
    red = 1
  }
  if((wavelength >= 380) && (wavelength<420)){
    fac <- 0.3   0.7*(wavelength - 380) / (420 - 380)
  }else if((wavelength >= 420) && (wavelength<701)){
    fac <- 1
  }else if((wavelength >= 701) && (wavelength<781)){
    fac <- 0.3   0.7*(780 - wavelength) / (780 - 700)
  }else{
    fac <- 0
  }
  do.call(rgb, as.list((c(red, green, blue) * fac)^0.8))
  })
}

Obviously, I don't have your data set, but the following code creates a plausible set of data over the correct ranges:

Data

set.seed(10)

bq <- setNames(as.data.frame(density(sample(rnorm(5, 600, 120)))[c("x", "y")]),
               c("w.length", "s.e.irrad"))

bq$s.e.irrad <- bq$s.e.irrad * 1e5