1
votes

I'm using the attached R code to create a custom color palette in R, that returns hexadecimal values based on the number of levels. The attached code works perfectly, but I'm having trouble understanding how the code understands the number of levels in the input vector. 'N' is an argument in the function within the function (check_pal_n inside create_pal), but 'n' is not one of the arguments you can pass to 'create_pal'.

Obviously the code works, but I want to understand better how it is working. Any help is appreciated!

library(tidyverse)

# create a labeled list of colors
custom_color_hexcodes <- c(
  `blue`  = "#002F6C",
  `red`  = "#BA0C2F",
  `light blue`  = "#A7C6ED",
  `medium blue`  = "#006789",
  `dark red`  = "#631032",
  `web blue` = "#205493",
  `rich black`  = "#212721",
  `dark grey` = "#6C6463",
  `medium grey`= "#8C8983",
  `light grey`= "#CFCDC9")

# wrap that list in a callable function
custom_cols <- function(...) {
  cols <- c(...)
  if (is.null(cols))
    return (custom_color_hexcodes)
  custom_color_hexcodes[cols]
}


# There are 10 colors, so our max number of colors will be 10.
check_pal_n <- function(n, max_n) {
  if (n > max_n) {
    warning("This palette can handle a maximum of ", max_n, " values.",
            "You have supplied ", n, ".")
  } else if (n < 0) {
    stop("`n` must be a non-negative integer.")
  }
}


custom_pal <- function(fill=TRUE){
  colors <- custom_color_hexcodes
  if (fill){
    max_n <- 9
    f <- function(n) {
      check_pal_n(n, max_n)
      if (n == 1L) {
        i <- "blue"
      } else if (n == 2L) {
        i <- c("blue", "red")
      } else if (n == 3L) {
        i <- c("blue", "red", "light blue")
    } else if (n == 4L) {
      i <- c("blue", "red", "light blue", "dark red")
    } else if (n %in% 5:6) {
      ## 20120901_woc904
      i <- c("blue", "red", "light blue", "dark red",
             "dark grey", "light grey")
    } else if (n == 7L) {
      # 20120818_AMC820
      i <- c("blue", "red", "light blue", "dark red",
             "dark grey", "light grey", "medium blue")
    } else if (n >= 8L) {
      # 20120915_EUC094
      i <- c("blue", "red", "light blue", "dark red",
             "dark grey", "light grey", "medium blue", "rich black")
    }
    unname(colors[i][seq_len(n)])
  }
} else {
  max_n <- 9
  f <- function(n) {
    check_pal_n(n, max_n)
    if (n <= 3) {
      i <- c("blue", "red", "light blue")
    } else if (n %in% 4:5) {
      # i <- c("blue", "red", "light blue", "dark red")
      i <- c("blue", "red", "light blue", "dark red", "dark grey")
    } else if (n == 6) {
      # 20120825_IRC829
      i <- c("blue", "red", "light blue", "dark red",
             "dark grey", "light grey")
    } else if (n > 6) {
      # 20120825_IRC829
      i <- c("blue", "red", "light blue", "dark red",
             "dark grey", "light grey", "medium blue", "rich black",
             "web blue", "medium grey")
      }
      unname(colors[i][seq_len(n)])
    }
  }
  attr(f, "max_n") <- max_n
  f
}


scale_colour <- function(...) {
  discrete_scale("colour", "custom_cols", custom_pal(), ...)
}

scale_fill <- function(...) {
  discrete_scale("fill", "custom_cols", custom_pal(), ...)
}
1
custom_pal creates functions of n. n will be an argument for whatever funtcion it returns. - Gregor Thomas
You might want to check colorRampPalette() from library(RColorBrewer). - ismirsehregal

1 Answers

1
votes

Assuming that by create_pal you mean custom_pal.

The custom_pal function returns a function (internally named f in the custom_pal function) that will take an argument n.

https://ggplot2.tidyverse.org/reference/discrete_scale.html explains the discrete_scale function: you pass it 'A palette function that when called with a single integer argument (the number of levels in the scale) returns the values that they should take.' In this case it is being passed the function returned by custom_pal.

ggplot will do the work of calling this function for you with the appropriate arguments.