研究でしばしば波長に関係するデータを出すため、波長に応じた色でプロットしたい場合が多い。
波長から色の変換の各種定数は、このページから。文字列から色コードへの変換が汚いが、いちおうOK。
関数
library(tidyverse)
library(stringr)
lambda2color <-
Vectorize(
function(lambda){
# central wavelength [nm]
central <-
c(red = 700.0,
green = 546.1,
blue = 435.8,
orange = 605.0,
yellow = 580.0,
cyan = 490.0,
purple = 400.0)
# half width [nm]
half_width <-
c(red = 90,
green = 80,
blue = 80,
orange = 60,
yellow = 50,
cyan = 50,
purple = 40)
# intensity of seven colors
intensity <-
c(red = .95,
green = .74,
blue = .75,
orange = .40,
yellow = .10,
cyan = .30,
purple = .30)
norms <-
intensity * exp( - (lambda - central)^2 / half_width^2)
r <- sum(norms[c("red", "orange", "purple")])
g <- sum(norms[c("green", "orange", "yellow", "cyan", "purple")] * c(1, .715, .83, 1, .5))
b <- sum(norms[c("blue", "orange", "cyan", "purple")] * c(1, .23, 1, 1))
r_8bit <- min(255, round(r*255, 0))
g_8bit <- min(255, round(g*255, 0))
b_8bit <- min(255, round(b*255, 0))
# to hexadecimal
to_hex <-
function(x){
hexed <-
as.hexmode(x) %>%
as.character
if(str_count(hexed) == 1){
paste0("0", hexed) %>% return
} else {
hexed
}
}
# #rrggbb
paste0("#", to_hex(r_8bit), to_hex(g_8bit), to_hex(b_8bit)) %>%
return
}
)
color_scale_bar <-
function(wavelength, y, ...){
lapply(wavelength, function(i){
annotate(geom = "point", x = i, y = y, col = lambda2color(i), ...)
})
}デモ
test_df <-
data_frame(wavelength = 400:800, value = sin(wavelength/2 / pi))
test_df %>%
ggplot(aes(x = wavelength, y = value, col = factor(wavelength))) +
guides(col = F) +
geom_point() +
geom_line(aes(group = NA)) +
scale_color_manual(values = lambda2color(test_df$wavelength))
test_df %>%
ggplot(aes(x = wavelength, y = value)) +
guides(col = F) +
geom_point() +
geom_line(aes(group = NA)) +
color_scale_bar(wavelength = 400:800, y = -1)
参考ページ
devtools::session_info()## Session info -------------------------------------------------------------## setting value
## version R version 3.5.0 (2018-04-23)
## system x86_64, darwin15.6.0
## ui X11
## language (EN)
## collate en_US.UTF-8
## tz Asia/Tokyo
## date 2018-05-05## Packages -----------------------------------------------------------------## package * version date source
## assertthat 0.2.0 2017-04-11 CRAN (R 3.5.0)
## backports 1.1.2 2017-12-13 CRAN (R 3.5.0)
## base * 3.5.0 2018-04-24 local
## bindr 0.1.1 2018-03-13 CRAN (R 3.5.0)
## bindrcpp 0.2.2 2018-03-29 CRAN (R 3.5.0)
## blogdown 0.6 2018-04-18 CRAN (R 3.5.0)
## bookdown 0.7 2018-02-18 CRAN (R 3.5.0)
## broom 0.4.4 2018-03-29 CRAN (R 3.5.0)
## cellranger 1.1.0 2016-07-27 CRAN (R 3.5.0)
## cli 1.0.0 2017-11-05 CRAN (R 3.5.0)
## colorspace 1.3-2 2016-12-14 CRAN (R 3.5.0)
## compiler 3.5.0 2018-04-24 local
## crayon 1.3.4 2017-09-16 CRAN (R 3.5.0)
## datasets * 3.5.0 2018-04-24 local
## devtools 1.13.5 2018-02-18 CRAN (R 3.5.0)
## digest 0.6.15 2018-01-28 CRAN (R 3.5.0)
## dplyr * 0.7.4 2017-09-28 CRAN (R 3.5.0)
## evaluate 0.10.1 2017-06-24 CRAN (R 3.5.0)
## forcats * 0.3.0 2018-02-19 CRAN (R 3.5.0)
## foreign 0.8-70 2017-11-28 CRAN (R 3.5.0)
## ggplot2 * 2.2.1 2016-12-30 CRAN (R 3.5.0)
## glue 1.2.0 2017-10-29 CRAN (R 3.5.0)
## graphics * 3.5.0 2018-04-24 local
## grDevices * 3.5.0 2018-04-24 local
## grid 3.5.0 2018-04-24 local
## gtable 0.2.0 2016-02-26 CRAN (R 3.5.0)
## haven 1.1.1 2018-01-18 CRAN (R 3.5.0)
## hms 0.4.2 2018-03-10 CRAN (R 3.5.0)
## htmltools 0.3.6 2017-04-28 CRAN (R 3.5.0)
## httr 1.3.1 2017-08-20 CRAN (R 3.5.0)
## jsonlite 1.5 2017-06-01 CRAN (R 3.5.0)
## knitr 1.20 2018-02-20 CRAN (R 3.5.0)
## labeling 0.3 2014-08-23 CRAN (R 3.5.0)
## lattice 0.20-35 2017-03-25 CRAN (R 3.5.0)
## lazyeval 0.2.1 2017-10-29 CRAN (R 3.5.0)
## lubridate 1.7.4 2018-04-11 CRAN (R 3.5.0)
## magrittr 1.5 2014-11-22 CRAN (R 3.5.0)
## memoise 1.1.0 2017-04-21 CRAN (R 3.5.0)
## methods * 3.5.0 2018-04-24 local
## mnormt 1.5-5 2016-10-15 CRAN (R 3.5.0)
## modelr 0.1.1 2017-07-24 CRAN (R 3.5.0)
## munsell 0.4.3 2016-02-13 CRAN (R 3.5.0)
## nlme 3.1-137 2018-04-07 CRAN (R 3.5.0)
## parallel 3.5.0 2018-04-24 local
## pillar 1.2.1 2018-02-27 CRAN (R 3.5.0)
## pkgconfig 2.0.1 2017-03-21 CRAN (R 3.5.0)
## plyr 1.8.4 2016-06-08 CRAN (R 3.5.0)
## psych 1.8.3.3 2018-03-30 CRAN (R 3.5.0)
## purrr * 0.2.4 2017-10-18 CRAN (R 3.5.0)
## R6 2.2.2 2017-06-17 CRAN (R 3.5.0)
## Rcpp 0.12.16 2018-03-13 CRAN (R 3.5.0)
## readr * 1.1.1 2017-05-16 CRAN (R 3.5.0)
## readxl 1.1.0 2018-04-20 CRAN (R 3.5.0)
## reshape2 1.4.3 2017-12-11 CRAN (R 3.5.0)
## rlang 0.2.0 2018-02-20 CRAN (R 3.5.0)
## rmarkdown 1.9 2018-03-01 CRAN (R 3.5.0)
## rprojroot 1.3-2 2018-01-03 CRAN (R 3.5.0)
## rstudioapi 0.7 2017-09-07 CRAN (R 3.5.0)
## rvest 0.3.2 2016-06-17 CRAN (R 3.5.0)
## scales 0.5.0 2017-08-24 CRAN (R 3.5.0)
## stats * 3.5.0 2018-04-24 local
## stringi 1.1.7 2018-03-12 CRAN (R 3.5.0)
## stringr * 1.3.0 2018-02-19 CRAN (R 3.5.0)
## tibble * 1.4.2 2018-01-22 CRAN (R 3.5.0)
## tidyr * 0.8.0 2018-01-29 CRAN (R 3.5.0)
## tidyverse * 1.2.1 2017-11-14 CRAN (R 3.5.0)
## tools 3.5.0 2018-04-24 local
## utils * 3.5.0 2018-04-24 local
## withr 2.1.2 2018-03-15 CRAN (R 3.5.0)
## xfun 0.1 2018-01-22 CRAN (R 3.5.0)
## xml2 1.2.0 2018-01-24 CRAN (R 3.5.0)
## yaml 2.1.18 2018-03-08 CRAN (R 3.5.0)