显示与调色板中的颜色相关联的名称而不是十六进制代码

Question

我需要经常使用的颜色调色板（my_pal）。为了与此调色板进行交互，我从here调整了my_color_pal它确实有效，但有时我希望能够在调色板中显示名称而不是十六进制颜色代码。有可能吗？

my_pal <- {
  x$y <- list()
  x$y$seasons <- c(
    autumn = rgb(100, 78, 139, max = 255),
    spring = rgb(200, 139, 61, max = 255),
    summer = rgb(54, 50, 205, max = 255),
    winter = rgb(255, 193, 37, max = 255)
  )
  x
}


my_color_pal <- function(palette = "seasons") {
  pal.list <- my_pal$y
  if (!palette %in% c(names(pal.list), "seasons", "blah", "bluh")) {
    stop(sprintf("%s is not a valid palette name", palette))
  }
  if (palette == "seasons") {
    types <- pal.list[["seasons"]][seq(1, 4, by = 1)]
  } else if (palette == "blah") {
    types <- pal.list[["blah"]][seq(1, 8, by = 2)]
  } else {
    types <- pal.list[[palette]]
  }
  function(n) {
    unname(types)[seq_len(n)]
  }
}


library(scales)
show_col(my_color_pal("seasons")(4))

Answer 1

如果将季节名称和十六进制代码存储在函数中，则可以在构建绘图时检索要显示的类型。这是一个包含my_color_pal函数中scale :: show_col的大部分内部的示例，然后允许您使用字符串值“hex”或“names”绘制名称或十六进制代码。

my_pal <- {
  x <- list()
  x$y <- list()
  x$y$seasons <- c(
    autumn = rgb(100, 78, 139, max = 255),
    spring = rgb(200, 139, 61, max = 255),
    summer = rgb(54, 50, 205, max = 255),
    winter = rgb(255, 193, 37, max = 255)
  )
  x
}


my_color_pal <- function(palette, names_or_hex) {

  pal.list <- my_pal$y
  if (!palette %in% c(names(pal.list), "seasons", "blah", "bluh")) {
    stop(sprintf("%s is not a valid palette name", palette))
  }
  if (palette == "seasons") {
    types <- pal.list[["seasons"]][seq(1, 4, by = 1)]
  } else if (palette == "blah") {
    types <- pal.list[["blah"]][seq(1, 8, by = 2)]
  } else {
    types <- pal.list[[palette]]
  }

  # get hexs
  colours <- unname(types)[seq_len(length(types))]

  # get names
  names_colours <- names(types)[seq_len(length(types))]

  # functions internal to scales::show_col()
  n <- length(colours)
  ncol <- ceiling(sqrt(n))
  nrow <- ceiling(n/ncol)
  colours <- c(colours, rep(NA, nrow * ncol - length(colours)))
  colours <- matrix(colours, ncol = ncol, byrow = TRUE)
  old <- par(pty = "s", mar = c(0, 0, 0, 0))
  on.exit(par(old))
  size <- max(dim(colours))
  plot(c(0, size), c(0, -size), type = "n", xlab = "", ylab = "", 
       axes = FALSE)
  rect(col(colours) - 1, -row(colours) + 1, col(colours), -row(colours), 
       col = colours)

  # add condtional plotting of hex codes or names
  if (names_or_hex == "hex") {
    text(col(colours) - 0.5, -row(colours) + 0.5, colours)
  } else if(names_or_hex == "names"){
    text(col(colours) - 0.5, -row(colours) + 0.5, names_colours)
  }

}

# plot and display hex codes
my_color_pal(palette = "seasons",
             names_or_hex = "hex")

# plot and display names
my_color_pal(palette = "seasons",
             names_or_hex = "names")