R: Get qualitative colors for a vector of characters

get_qual_colors.R

library(RColorBrewer)

qualitative_colours <- function(n, light=FALSE) {
  # Get a specified number of qualitative colours if possible.
  # This function will default to a continuous color scheme if there are more
  # than 21 colours needed.

  # rainbow12equal <- c("#BF4D4D", "#BF864D", "#BFBF4D", "#86BF4D", "#4DBF4D", "#4DBF86", "#4DBFBF", "#4D86BF", "#4D4DBF", "#864DBF", "#BF4DBF", "#BF4D86")
  rich12equal <- c("#000040", "#000093", "#0020E9", "#0076FF", "#00B8C2", "#04E466", "#49FB25", "#E7FD09", "#FEEA02", "#FFC200", "#FF8500", "#FF3300")

  # Qualitative colour schemes by Paul Tol
  ifelse(n >= 19 & n <= 21,
    # return 21 qualitative color scheme
    return(colorRampPalette(c("#771155", "#AA4488", "#CC99BB", "#114477", "#4477AA", "#77AADD", "#117777", "#44AAAA", "#77CCCC", "#117744", "#44AA77", "#88CCAA", "#777711", "#AAAA44", "#DDDD77", "#774411", "#AA7744", "#DDAA77", "#771122", "#AA4455", "#DD7788"))(n)),
  ifelse(n >= 16 & n <= 18,
    # up to 18 qualitative color scheme
    return(colorRampPalette(c("#771155", "#AA4488", "#CC99BB", "#114477", "#4477AA", "#77AADD", "#117777", "#44AAAA", "#77CCCC", "#777711", "#AAAA44", "#DDDD77", "#774411", "#AA7744", "#DDAA77", "#771122", "#AA4455", "#DD7788"))(n)),
  ifelse(n == 15, 
    # 15 qualitative color scheme
    return(colorRampPalette(c("#114477", "#4477AA", "#77AADD", "#117755", "#44AA88", "#99CCBB", "#777711", "#AAAA44", "#DDDD77", "#771111", "#AA4444", "#DD7777", "#771144", "#AA4477", "#DD77AA"))(n)),
  ifelse(n > 12 & n <= 14,
    # 14 qualitative color scheme
    return(colorRampPalette(c("#882E72", "#B178A6", "#D6C1DE", "#1965B0", "#5289C7", "#7BAFDE", "#4EB265", "#90C987", "#CAE0AB", "#F7EE55", "#F6C141", "#F1932D", "#E8601C", "#DC050C"))(n)),
  ifelse(n > 9 & n <= 12,
    ifelse(light,
      return(RColorBrewer::brewer.pal(n=n, name='Set3')),
      return(RColorBrewer::brewer.pal(n=n, name='Paired'))
    ),
  ifelse(n <= 9,
    ifelse(light,
      return(RColorBrewer::brewer.pal(n=n, name='Pastel1')),
      return(RColorBrewer::brewer.pal(n=n, name='Set1'))
    ),
    # else(n > 21,
    # If there are more than 21 qualitative colours, default to a continuous 
    # colour scheme, rich12equal in this case 
    return(colorRampPalette(rich12equal)(n))
  ))))))
}


get_qual_col_for_vector <- function(x) {
  types <- unique(x)
  types <- types[!is.na(types)]

  type_colors <- qualitative_colours(length(types))

  colors_types <- as.vector(x)

  count_types <- 1
  count_colors <- 1


  while (count_types <= length(types))
  {
    if (count_colors > length(type_colors))
    {
      count_colors <- 1
    }

    colors_types[colors_types == types[count_types]] <- type_colors[count_colors]

    count_colors <- count_colors + 1
    count_types <- count_types + 1
  }

  return(list(colors=colors_types, n=length(types), types=types, type_colors=type_colors))
}