Marie-Eve
Marie-Eve

Reputation: 585

Display names associated with colors in a palette instead of hex codes

I've a palette of colors (my_pal) that I need to use very often. To interact with this palette, I've adapted my_color_pal from here It does work, but sometimes I want to be able to display the names in my palette instead of the hex color codes. Is it possible?

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))

enter image description here

Upvotes: 2

Views: 871

Answers (1)

Pete Barwis
Pete Barwis

Reputation: 114

If you store the season names and the hex codes in your function, then you can retrieve the type you want to show when you build the plot. Here's an example that includes most of the internals of scales::show_col in your my_color_pal function, and then allows you to plot names or hex codes using a string value of "hex" or "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")

Upvotes: 1

Related Questions