colour ggplot with hue & brightness

scale_colour_hb.R

# Define a character to act as seperator between the two variables to be used
hb_sep <- function(x=NULL){
  if(is.null(x)){
    getOption("hb_sep")
  } else {
    options(hb_sep = x)
  }
}

# Combines the hue & brightness
hb <- function(h,b) paste(h,b,sep=hb_sep())

# Convert the output of hb() to a colour
hb_to_rgb <- function(x,h=c(0,360)+15,b=c(70,100)){
  
  x <- as.factor(x)
  
  hb_long <- strsplit(as.character(x),hb_sep())
  
  h_vals <- vapply(hb_long,`[`,1,FUN.VALUE=character(1))
  b_vals <- vapply(hb_long,`[`,2,FUN.VALUE=character(1))
  
  h_levels <- unique(h_vals)
  b_levels <- unique(b_vals)
  
  h_nums <- seq(h[1],h[2],length.out=length(h_levels)+1)[-1]
  b_nums <- seq(b[1],b[2],length.out=length(b_levels))
  
  hb_tbl <- cbind(
      expand.grid(h_lev=h_levels,b_lev = b_levels),
      expand.grid(h=h_nums,b=b_nums)
    )
  
  hb_tbl$hb_levels <- with(hb_tbl,paste(h_lev,b_lev,sep=hb_sep()))
  
  hb_tbl$rgb <- hcl(h=hb_tbl$h,l=hb_tbl$b)
  
  print(hb_tbl)
  
  out_ref <- setNames(unlist(hb_tbl$rgb),hb_tbl$hb_level)
  
  out_ref[as.character(x)]
  
}

#Internal function for the scale_colour_hb() function
hb_pal <- function(h,b){
  function(n){
    hb_to_rgb(parent.frame(2)$limits,h,b)
  }
}

# Create the appropriate scaling
scale_colour_hb <- function(h=c(0,360)+15,b=c(70,90),palette="Set 1",...,
                            guide="legend",aesthetic="colour"){
  ggplot2::discrete_scale(aesthetic,"hb",hb_pal(h=h,b=b)
                 ,...,guide=guide)
}

##########################################

#Load tidyverse (although not needed for the above functions)
library(tidyverse)

#Set the seperator
hb_sep(" & ")

#Create randomised data.frame and then nudge y depending on A & B
df <- data.frame(
  x = runif(100),
  y = runif(100),
  A = sample(c("a","b","c","d"),100,replace=TRUE),
  B = sample(c("x","y","z"),100,replace=TRUE)
) %>%
  mutate(y = y + recode(A,a=1,b=2,c=3,d=4),
         y = y + recode(B,x=0.1,y=0.2,z=0.3))

#Plot using the hue functions as above
df %>%
  ggplot() +
  aes(x=x,y=y,col=hb(A,B)) +
  geom_point() +
  geom_line() +
  scale_colour_hb(guide=guide_legend(title="A by B",ncol=4))