自定义调色板，从colorspace::choose_palete()向导提取函数

Question

我需要实现一个自定义调色板(我不喜欢可用的预设(。我从colorspace包中找到了一个有用的函数，它允许使用简单的GUI创建调色板。功能是choose_palette()使用GUI可以选择颜色、亮度等。。。我想做的是获得生成我的自定义调色板的功能，使用下面的工作流程：

library(colorspace)
#I create my custom palette using the GUI
my_custom_palette<-choose_palette()
#play with the parameters and save
#now I have the function my_custom_palette
view(my_custom_palette)
function (n, h = c(255, 158), c = c(50, 80), l = c(20, 97), 
power = c(2.04778156996587, 0.767918088737201), gamma = NULL, 
fixup = TRUE, alpha = 1, palette = NULL, rev = FALSE, register = NULL, 
..., h1, h2, c1, l1, l2, p1, p2, cmax = NULL) 
{
if (!is.null(gamma)) 
warning("'gamma' is deprecated and has no effect")
if (n < 1L) 
return(character(0L))
if (is.character(h)) 
palette <- h
pals <- if (!is.null(palette)) {
as.matrix(hcl_palettes(type = "Diverging", palette = palette)[, 
2L:11L])[1L, ]
}
else {
structure(c(rep_len(h, 2L), c(c[1L], NA), rep_len(l, 
2L), if (length(power) < 2L) c(power, NA) else rep_len(power, 
2L), if (length(c) > 1L) c[2L] else NA, 1), .Names = vars.pal)
}
if (!missing(h) && !is.character(h)) {
h <- rep_len(h, 2L)
pals["h1"] <- h[1L]
pals["h2"] <- h[2L]
}
if (!missing(c)) {
pals["c1"] <- c[1L]
if (length(c) > 1L) 
pals["cmax"] <- c[2L]
}
if (!missing(l)) {
l <- rep_len(l, 2L)
pals["l1"] <- l[1L]
pals["l2"] <- l[2L]
}
if (!missing(power)) {
power <- if (length(power) < 2L) 
c(power, NA)
else rep_len(power, 2L)
pals["p1"] <- power[1L]
pals["p2"] <- power[2L]
}
if (!missing(fixup)) 
pals["fixup"] <- as.logical(fixup)
if (!missing(h1)) 
pals["h1"] <- h1
if (!missing(h2)) 
pals["h2"] <- h2
if (!missing(c1)) 
pals["c1"] <- c1
if (!missing(l1)) 
pals["l1"] <- l1
if (!missing(l2)) 
pals["l2"] <- l2
if (!missing(p1)) 
pals["p1"] <- p1
if (!missing(p2)) 
pals["p2"] <- p2
if (!missing(cmax)) 
pals["cmax"] <- cmax
pals["c2"] <- NA
if (is.character(register) && nchar(register) > 0L) {
add_hcl_pals(palette = register, type = "Diverging", 
parameters = pals)
register <- TRUE
}
else {
register <- FALSE
}
if (is.na(pals["p2"])) 
pals["p2"] <- pals["p1"]
n2 <- ceiling(n/2)
rval <- seq.int(1, by = -2/(n - 1), length.out = n2)
rval <- c(seqhcl(rval, pals["h1"], pals["h1"], pals["c1"], 
0, pals["l1"], pals["l2"], pals["p1"], pals["p2"], pals["cmax"], 
as.logical(pals["fixup"]), ...), rev(seqhcl(rval, pals["h2"], 
pals["h2"], pals["c1"], 0, pals["l1"], pals["l2"], pals["p1"], 
pals["p2"], pals["cmax"], as.logical(pals["fixup"]), 
...)))
if (floor(n/2) < n2) 
rval <- rval[-n2]
if (!missing(alpha)) {
alpha <- pmax(pmin(alpha, 1), 0)
alpha <- format(as.hexmode(round(alpha * 255 + 1e-04)), 
width = 2L, upper.case = TRUE)
rval <- ifelse(is.na(rval), NA, paste(rval, alpha, sep = ""))
}
if (rev) 
rval <- rev(rval)
if (register) 
invisible(rval)
else return(rval)
}

现在，我想有了函数代码，我可以在一个闪亮的应用程序中创建调色板，而无需使用choose_palete((启动GUI

所以，我键入

my_custom_palette_2<-function (n, h = c(255, 158), c = c(50, 80), l = c(20, 97), 
power = c(2.04778156996587, 0.767918088737201), gamma = NULL, 
fixup = TRUE, alpha = 1, palette = NULL, rev = FALSE, register = NULL, 
..., h1, h2, c1, l1, l2, p1, p2, cmax = NULL) 
{
if (!is.null(gamma)) 
warning("'gamma' is deprecated and has no effect")
if (n < 1L) 
return(character(0L))
if (is.character(h)) 
palette <- h
pals <- if (!is.null(palette)) {
as.matrix(hcl_palettes(type = "Diverging", palette = palette)[, 
2L:11L])[1L, ]
}
else {
structure(c(rep_len(h, 2L), c(c[1L], NA), rep_len(l, 
2L), if (length(power) < 2L) c(power, NA) else rep_len(power, 
2L), if (length(c) > 1L) c[2L] else NA, 1), .Names = vars.pal)
}
if (!missing(h) && !is.character(h)) {
h <- rep_len(h, 2L)
pals["h1"] <- h[1L]
pals["h2"] <- h[2L]
}
if (!missing(c)) {
pals["c1"] <- c[1L]
if (length(c) > 1L) 
pals["cmax"] <- c[2L]
}
if (!missing(l)) {
l <- rep_len(l, 2L)
pals["l1"] <- l[1L]
pals["l2"] <- l[2L]
}
if (!missing(power)) {
power <- if (length(power) < 2L) 
c(power, NA)
else rep_len(power, 2L)
pals["p1"] <- power[1L]
pals["p2"] <- power[2L]
}
if (!missing(fixup)) 
pals["fixup"] <- as.logical(fixup)
if (!missing(h1)) 
pals["h1"] <- h1
if (!missing(h2)) 
pals["h2"] <- h2
if (!missing(c1)) 
pals["c1"] <- c1
if (!missing(l1)) 
pals["l1"] <- l1
if (!missing(l2)) 
pals["l2"] <- l2
if (!missing(p1)) 
pals["p1"] <- p1
if (!missing(p2)) 
pals["p2"] <- p2
if (!missing(cmax)) 
pals["cmax"] <- cmax
pals["c2"] <- NA
if (is.character(register) && nchar(register) > 0L) {
add_hcl_pals(palette = register, type = "Diverging", 
parameters = pals)
register <- TRUE
}
else {
register <- FALSE
}
if (is.na(pals["p2"])) 
pals["p2"] <- pals["p1"]
n2 <- ceiling(n/2)
rval <- seq.int(1, by = -2/(n - 1), length.out = n2)
rval <- c(seqhcl(rval, pals["h1"], pals["h1"], pals["c1"], 
0, pals["l1"], pals["l2"], pals["p1"], pals["p2"], pals["cmax"], 
as.logical(pals["fixup"]), ...), rev(seqhcl(rval, pals["h2"], 
pals["h2"], pals["c1"], 0, pals["l1"], pals["l2"], pals["p1"], 
pals["p2"], pals["cmax"], as.logical(pals["fixup"]), 
...)))
if (floor(n/2) < n2) 
rval <- rval[-n2]
if (!missing(alpha)) {
alpha <- pmax(pmin(alpha, 1), 0)
alpha <- format(as.hexmode(round(alpha * 255 + 1e-04)), 
width = 2L, upper.case = TRUE)
rval <- ifelse(is.na(rval), NA, paste(rval, alpha, sep = ""))
}
if (rev) 
rval <- rev(rval)
if (register) 
invisible(rval)
else return(rval)
}

对于这两个调色板，代码是相同的，第一个是用choose_palete((创建的，第二个不起作用：

my_custom_palette(5)
[1] "#002F70" "#717B99" "#F6F6F6" "#518673" "#00421A"
my_custom_palette_2(5)
Error in my_custom_palette_2(5) : 
promise already under evaluation: recursive default argument reference or earlier problems?

怎么了？提前感谢

Answer 1

我用@Achim-Zeileis提出的函数解决了这个问题：从GUI中选择的所有参数我创建了这个函数

`custom_color_palette<-function(n){colorspace::diverge_hcl(n, gamma = NULL,fixup = TRUE, alpha = 1, palette = NULL, rev = FALSE, register = NULL, h1=255, h2=119, c1=53,l1=33,l2=82,p1=.01,p2=1.3, cmax = 93)}
`

通过这种方式，我可以在绘图中回忆它，指定我需要的不同颜色的数量：

plot_ly(x=x,y=y,color=group,colors=custom_color_palette(5))

Answer 2

罪魁祸首是函数定义中的h = c(255, 158), c = c(50, 80)。这适用于colorspace包内的NAMESPACE语义，因为很明显，用于定义h的函数c()是base::c()。在您的自定义代码中，它是不清楚的，并导致递归，因为R试图首先确定c参数的值。

但是你的问题有一个更简单的解决方案。使用您选择的参数，您可以通过简单地计算调色板中的颜色

diverging_hcl(5, h = c(255, 158), c = c(50, 80),
l = c(20, 97), power = c(2.05, 0.77))
## [1] "#002F70" "#717B99" "#F6F6F6" "#528673" "#00421A"

或者，您也可以使用名称注册调色板，然后使用该名称：

diverging_hcl(5, h = c(255, 158), c = c(50, 80),
l = c(20, 97), power = c(2.05, 0.77), register = "mypal")
diverging_hcl(5, "mypal")
## [1] "#002F70" "#717B99" "#F6F6F6" "#528673" "#00421A"

您也可以将后一个调用放入.Rprofile中，以便每次启动R.时都有可用的调色板

通过注册的选项也在右侧>导出>注册选项卡的hclwizard()/choose_palette()闪亮版本中明确指出。在Tcl/Tk版本中，您也可以在顶部的"注册"选项卡中注册调色板。

注意，在任何情况下，生成的调色板都可以进一步调整，例如

diverging_hcl(5, "mypal", c = 0)
## [1] "#303030" "#6B7BA6" "#F6F6F6" "#338A6F" "#303030"