曲线下渐变填充区域

Question

我想用光谱颜色填充曲线下的区域，得到这样的图。

这就是我尝试过的

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

得到这个

还尝试使用 geom_area

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

但无法填充渐变

我的数据框的 x 为波长，y 为辐照度

Answer 1

以下内容应该接近您要寻找的内容。诀窍是使用scale_color_identity，geom_segment并将代表数据帧中每个波长的 RGB 字符串传递给颜色美学。

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()

或者，如果您想要更柔和的外观：

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()

唯一的缺点是您需要定义nm_to_RGB：将光的波长转换为十六进制字符串以表示颜色的函数。我不确定是否有一种“正确”的方法来做到这一点，但一种可能的实现（我从此处的javascript 函数翻译而来）将是：

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))
  })
}

显然，我没有您的数据集，但以下代码在正确的范围内创建了一组合理的数据：

数据

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