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

Question

我需要实现一个定制的调色板(我不喜欢预置可用)。我发现一个有用的函数，它允许使用一个简单的GUI创建一个调色板。该功能是choose_palette()使用图形界面，可以选择颜色，亮度等。我想要做的是让tha生成我的自定义调色板，se工作流如下：

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_palette()启动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)
}

对于2个调色板，代码是相同的，第一个是用choose_palette()创建的，第二个不工作：

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

罪魁祸首是函数定义中的h = c(255, 158), c = c(50, 80)。这适用于NAMESPACE包中的colorspace语义，因为用于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时都可以使用调色板。

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

请注意，在任何情况下，结果调色板都可以进一步调整，例如，

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

Answer 2

我用@Achim提出的函数解析了这个方法:从我创建的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))