annotate nmr_annotation2d/viridis.R @ 1:a4d2b1926e13 draft

Uploaded
author marie-tremblay-metatoul
date Tue, 04 Feb 2020 04:05:38 -0500
parents
children
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
1
a4d2b1926e13 Uploaded
marie-tremblay-metatoul
parents:
diff changeset
1 viridis <- function (n, alpha = 1, begin = 0, end = 1, direction = 1, option = "D")
a4d2b1926e13 Uploaded
marie-tremblay-metatoul
parents:
diff changeset
2 {
a4d2b1926e13 Uploaded
marie-tremblay-metatoul
parents:
diff changeset
3 if (begin < 0 | begin > 1 | end < 0 | end > 1) {
a4d2b1926e13 Uploaded
marie-tremblay-metatoul
parents:
diff changeset
4 stop("begin and end must be in [0,1]")
a4d2b1926e13 Uploaded
marie-tremblay-metatoul
parents:
diff changeset
5 }
a4d2b1926e13 Uploaded
marie-tremblay-metatoul
parents:
diff changeset
6 if (abs(direction) != 1) {
a4d2b1926e13 Uploaded
marie-tremblay-metatoul
parents:
diff changeset
7 stop("direction must be 1 or -1")
a4d2b1926e13 Uploaded
marie-tremblay-metatoul
parents:
diff changeset
8 }
a4d2b1926e13 Uploaded
marie-tremblay-metatoul
parents:
diff changeset
9 if (direction == -1) {
a4d2b1926e13 Uploaded
marie-tremblay-metatoul
parents:
diff changeset
10 tmp <- begin
a4d2b1926e13 Uploaded
marie-tremblay-metatoul
parents:
diff changeset
11 begin <- end
a4d2b1926e13 Uploaded
marie-tremblay-metatoul
parents:
diff changeset
12 end <- tmp
a4d2b1926e13 Uploaded
marie-tremblay-metatoul
parents:
diff changeset
13 }
a4d2b1926e13 Uploaded
marie-tremblay-metatoul
parents:
diff changeset
14 option <- switch(EXPR = option, A = "A", magma = "A",
a4d2b1926e13 Uploaded
marie-tremblay-metatoul
parents:
diff changeset
15 B = "B", inferno = "B", C = "C", plasma = "C",
a4d2b1926e13 Uploaded
marie-tremblay-metatoul
parents:
diff changeset
16 D = "D", viridis = "D", E = "E", cividis = "E",
a4d2b1926e13 Uploaded
marie-tremblay-metatoul
parents:
diff changeset
17 {
a4d2b1926e13 Uploaded
marie-tremblay-metatoul
parents:
diff changeset
18 warning(paste0("Option '", option, "' does not exist. Defaulting to 'viridis'."))
a4d2b1926e13 Uploaded
marie-tremblay-metatoul
parents:
diff changeset
19 "D"
a4d2b1926e13 Uploaded
marie-tremblay-metatoul
parents:
diff changeset
20 })
a4d2b1926e13 Uploaded
marie-tremblay-metatoul
parents:
diff changeset
21 map <- viridisLite::viridis.map[viridisLite::viridis.map$opt ==
a4d2b1926e13 Uploaded
marie-tremblay-metatoul
parents:
diff changeset
22 option, ]
a4d2b1926e13 Uploaded
marie-tremblay-metatoul
parents:
diff changeset
23 map_cols <- grDevices::rgb(map$R, map$G, map$B)
a4d2b1926e13 Uploaded
marie-tremblay-metatoul
parents:
diff changeset
24 fn_cols <- grDevices::colorRamp(map_cols, space = "Lab",
a4d2b1926e13 Uploaded
marie-tremblay-metatoul
parents:
diff changeset
25 interpolate = "spline")
a4d2b1926e13 Uploaded
marie-tremblay-metatoul
parents:
diff changeset
26 cols <- fn_cols(seq(begin, end, length.out = n))/255
a4d2b1926e13 Uploaded
marie-tremblay-metatoul
parents:
diff changeset
27 grDevices::rgb(cols[, 1], cols[, 2], cols[, 3], alpha = alpha)
a4d2b1926e13 Uploaded
marie-tremblay-metatoul
parents:
diff changeset
28 }