Sunlight Foundation palettes, based on the Wes Anderson code

colors.R

# Sunlight Foundation style guide: http://design.sunlightlabs.com/projects/Sunlight-StyleGuide-DataViz.pdf
# Ram's original Wes Anderson code: https://github.com/karthik/wesanderson/blob/master/R/colors.R

#' A Wes Anderson palette generator
#'
#' These are a handful of color palettes from Wes Anderson movies. 
#' @param n Number of colors desired. Unfortunately most palettes now only have 4 or 5 colors. But hopefully we'll add more palettes soon. All color schemes are derived from the most excellent Tumblr blog: \href{http://wesandersonpalettes.tumblr.com/}{Wes Anderson Palettes}
#' @param  name Name of desired palette. Choices are: \code{GrandBudapest}, \code{Moonrise1},  \code{Royal1},  \code{Moonrise2}, \code{Cavalcanti},  \code{Royal2}, \code{GrandBudapest2},  \code{Moonrise3},  \code{Chevalier}, \code{BottleRocket}, \code{darjeeling}, \code{darjeeling2} 
#' @param type Set to continuous if you require a gradient of colors similar to how heat map works.
#' @export
#' @keywords colors
#' @examples 
#' sun.palette(3, "Royal1")
#' sun.palette(3, "GrandBudapest")
#' sun.palette(5, "Cavalcanti")
#' # You can also request a continuous range of colors
#' pal <- sun.palette(name = "Zissou", type = "continuous")
#' image(volcano, col = pal(21))

sun.palette <- function(n, name, type = FALSE) {
  
  baseColors <- c("#EFECEA",  # Background
                  "#F5F3F2",  # Background Light Accent
                  "#E5E2E0",  # Background Dark Accent
                  "#635F5D",  # Text Main
                  "#8E8883",  # Text Light
                  "#FFFFFF",  # Line White
                  "#C0C0BB",  # Line Grey Accent
                  "#E5E2E0")  # No Data
  
  # Data colors
  
  mainColors <- c("#E3BA22", "#E6842A", "#137B80", "#8E6C8A",  # Primaries
                  "#F2DA57", "#F6B656", "#42A5B3", "#B396AD",  # Light subset
                  "#BD8F22", "#BA5F06", "#005D6E", "#684664",  # Dark subset
                  "#978F80", "#C1BAA9", "#7C715E")  # Neutral things
  
  specialtyColors <- c("#9A3E25",  # Republican
                       "#156B90",  # Democrat
                       "#708259",  # Independent
                       "#BD2D28",  # Con
                       "#0F8C79",  # Pro
                       "#5C8100")  # Money
  
  specialtySubsetColors <- c("#B37055",  # Republican
                             "#688BAB",  # Democrat
                             "#95A17E",  # Independent
                             "#E25A42",  # Con
                             "#6BBBA1",  # Pro
                             "#A0B700")  # Money
  
  # Choropleth colors
  
  republicanRange <- c("#712422", "#9A3E25", "#B37055", "#D9A78D", "#EDCEBC")
  democratRange <- c("#05426C", "#156B90", "#688BAB", "#8CAEC6", "#BAD2E2")
  repToDemRange <- c("#9A3E25", "#D9A78D", "#C8C6C6", "#8CAEC6", "#156B90")
  antiToProRange <- c("#BD2D28", "#C37A73", "#C8C6C6", "#75A999", "#0F8C79")
  moneyRange <- c("#0C4E00", "#5C8100", "#A0B700", "#D2CF00", "#E6E4A6")
  thingRange <- c("#936B00", "#BD8F22", "#E3BA22", "#F2DA57", "#F1E8AE")
  
  networkGraphColors <- c("#F2DA57", "#F6B656", "#E25A42", "#DCBDCF", "#B396AD",  # Main
                          "#B0CBDB", "#33B6D0", "#7ABFCC", "#C8D7A1", "#A0B700",
                          
                          "#E3BA22", "#E58429", "#BD2D28", "#D15A86", "#8E6C8A",  # Lighter
                          "#6B99A1", "#42A5B3", "#0F8C79", "#6BBBA1", "#5C8100",
                          
                          "#B08B12", "#BA5F06", "#8C3B00", "#6D191B", "#842854",  # Darker
                          "#5F7186", "#193556", "#137B80", "#144847", "#254E00")

  hclSweep <- hcl(h = seq(0, 255, len = 100),
                  c = seq(100, 0, len = 100),
                  l = seq(100, 0, len = 100))

  namelist <- ls()
  print(namelist)
  
  if(!name %in% namelist)
    stop("Palette not found.")
  
  if(type == "continuous") {
    colorRampPalette(get(name), space="Lab")
  } else {
    if(!type) {
      if(n > namelist[which(namelist == name)])
        stop("Number of requested colors greater than what palette can offer")
      
      get(name)[1:n]
    } 
  }
  
}



#' Display a palette
#'
#' @param n Number of colors desired. Unfortunately most palettes now only have 4 or 5 colors. But hopefully we'll add more palettes soon. All color schemes are derived from the most excellent Tumblr blog: \href{http://wesandersonpalettes.tumblr.com/}{Wes Anderson Palettes}
#' @param  name Name of desired palette. Choices are: \code{GrandBudapest}, \code{Moonrise1},  \code{Royal1},  \code{Moonrise2}, \code{Cavalcanti},  \code{Royal2}, \code{GrandBudapest2},  \code{Moonrise3},  \code{Chevalier} , \code{BottleRocket} , \code{darjeeling}, \code{darjeeling2}
#' @export
#' @examples \dontrun{
#'	display.sun.palette(3, "Royal1")
#'}
display.sun.palette <- function(n, name) {
  
  if(!name %in% namelist)
    stop("Palette not found.")
  
  if(n > namelist[which(namelist == name)])
    stop("Number of requested colors greater than what palette can offer")
  
  
  image(1:n,1,as.matrix(1:n),col= sun.palette(n,name),
        xlab=name, ylab = "",xaxt = "n",yaxt = "n", bty = "n")
  
}


ggplot(iris, aes(Sepal.Length, Sepal.Width, color = Species)) + 
  geom_point(size = 3) + 
  scale_color_manual(values = sun.palette(3, "moneyRange")) + 
  theme_gray()

sunlight_colors as an object rather than a function.R

sunlight_colors <- list()

sunlight_colors$background <- c("#EFECEA", "#F5F3F2", "#E5E2E0", "#635F5D", "#8E8883", "#FFFFFF", "#C0C0BB", "#E5E2E0")
names(sunlight_colors$background) <- c("Background", "Background Light Accent", "Background Dark Accent", "Text Main", "Text Light", "Line White", "Line Grey Accent", "No Data")
sunlight_colors$main <- matrix(c("#E3BA22", "#F2DA57", "#BD8F22",
         "#E6842A", "#F6B656", "#BA5F06",
         "#137B80", "#42A5B3", "#005D6E",
         "#8E6C8A", "#B396AD", "#684664",
         "#978F80", "#C1BAA9", "#7C715E"),
       nrow = 3)
colnames(sunlight_colors$main) <- c("thing", "different", "another", "another different", "neutral")
rownames(sunlight_colors$main) <- c("primary", "light", "dark")

sunlight_colors$choropleth$rep_dem <- c("#9A3E25", "#D9A78D", "#C8C6C6", "#8CAEC6", "#156B90")
sunlight_colors$choropleth$anti_pro <- c("#BD2D28", "#C37A73", "#C8C6C6", "#75A999", "#0F8C79")
sunlight_colors$choropleth$money <- c("#0C4E00", "#5C8100", "#A0B700", "#D2CF00", "#E6E4A6")
sunlight_colors$choropleth$thing <- c("#936B00", "#BD8F22", "#E3BA22", "#F2DA57", "#F1E8AE")

sunlight_colors$network <- matrix(
  c("#F2DA57", "#E3BA22", "#B08B12", "#F6B656", "#E58429",
    "#BA5F06", "#E25A42", "#BD2D28", "#8C3B00", "#DCBDCF",
    "#D15A86", "#6D191B", "#B396AD", "#8E6C8A", "#842854",
    "#B0CBDB", "#6B99A1", "#5F7186", "#33B6D0", "#42A5B3",
    "#193556", "#7ABFCC", "#0F8C79", "#137B80", "#C8D7A1",
    "#6BBBA1", "#144847", "#A0B700", "#5C8100", "#254E00"),
  nrow = 3)
colnames(sunlight_colors$network) <- LETTERS[1:ncol(sunlight_colors$network)]
rownames(sunlight_colors$network) <- c("primary", "light", "dark")

sunlight_colors %>%
  reshape2::melt() %>%
  as_tibble() %>%
  mutate_all(as.character) %>%
  group_by(L1, L2) %>%
  mutate(rnk = row_number()) %>%
  ungroup() %>%
  mutate(Var1 = ifelse(is.na(Var1), L2, Var1),
         Var2 = ifelse(is.na(Var2), as.character(rnk), Var2),
         Var1 = as.factor(Var1),
         Var2 = as.factor((Var2))) %>%
  mutate(Var1 = forcats::fct_inorder(Var1),
         Var2 = forcats::fct_inorder(Var2)) %>%
  ggplot() +
  aes(x = Var1, y = Var2, fill = value) +
  geom_tile() +
  facet_wrap(~ L1, scale = "free") +
  scale_fill_identity() +
  scale_x_discrete(expand = c(0, 0)) +
  scale_y_discrete(expand = c(0, 0)) +
  theme_bw()