## Code and packages ----------------------------------------------------------- library("colorspace") library("grid") library("ggplot2") library("tmap") source("paletteGrid.R") ## palette() ------------------------------------------------------------------- palette("R3") palette() palette("R4") palette() ## palette.colors() ------------------------------------------------------------ palette.colors() palette.colors(4) palette.colors(10, recycle = TRUE) palette.colors(4, palette = "R4") palette.pals() ## hcl.colors ------------------------------------------------------------------ hcl.colors(8, palette = "Blues 3") hcl.colors(5, palette = "YlGnBu") hcl.colors(9, palette = "Purple-Green") hcl.pals() ## Figure 1 -------------------------------------------------------------------- data("whiteside", package = "MASS") ggplot(whiteside, aes(Temp, Gas, color = Insul)) + geom_point(size = 2) + scale_color_manual(name = "Insulation", values = palette.colors(palette = "R4")[c(2, 4)]) + ggtitle("Whiteside's data") + xlab("Outside temperature") + ylab("Gas consumption") + theme(legend.position = "none") + theme_minimal() data("nz", package = "spData") myfun <- function(x) { y <- format(round(x), big.mark = ",") z <- grepl("0,000", y, fixed = TRUE) | grepl("5,000", y, fixed = TRUE) z[range(seq_along(x))] <- TRUE y[!z] <- "" return(y) } tm_shape(nz) + tm_polygons(col = "Median_income", palette = "Blues", style = "cont", breaks = seq(20, 35, by = 5/3) * 1000, title = "Median income", legend.format = list(fun = myfun)) + tm_layout(frame = FALSE) ## Figure 2 -------------------------------------------------------------------- paletteGrids(list( "palette()" = palette.colors(palette = "R3"), "heat.colors(8)" = heat.colors(8), "terrain.colors(8)" = terrain.colors(8), "rainbow(8)" = rainbow(8), "gray.colors(8)" = gray.colors(8), "topo.colors(8)" = topo.colors(8), NULL, NULL, "cm.colors(8)" = cm.colors(8)), qual = c(TRUE, FALSE, FALSE, TRUE, FALSE, FALSE, FALSE, FALSE, FALSE) ) ## Figure 3 -------------------------------------------------------------------- specplot(hcl.colors(8, "Blues 3")) ## Figure 4 -------------------------------------------------------------------- tsplot <- function(palette = "R3", deutan = FALSE, legend = TRUE, ...) { ## color palette palette <- match.arg(palette, c("R3", "R4", "Okabe-Ito")) p <- switch(palette, "R3" = palette.colors(8, "R3")[c(1:3, 5)], "R4" = palette.colors(8, "R4")[c(1:3, 5)], "Okabe-Ito" = palette.colors(4, "Okabe-Ito")[c(1, 4, 2, 3)] ) ## emulate deuteranope vision? if(deutan) p <- colorspace::deutan(p) ## time series plot eu <- window(EuStockMarkets, end = 1998) plot(eu, log = "y", ylab = "EU Stock Prices", plot.type = "single", col = p, xlim = c(1991.6, 1998.4), lwd = 1.5, ...) text(1991.3, 5750, palette, pos = 4, cex = 1.3) ## legend or direct labeling if(legend) { legend(1991.3, 5750, colnames(eu), col = p, lty = 1, lwd = 3, bty = "n") } else { text(1998, tail(eu, 1), colnames(eu), pos = 4, col = p, xpd = TRUE) } invisible(p) } par(mfrow = c(3, 2), mar = c(5, 4, 2, 1)) tsplot(palette = "R3", deutan = FALSE, legend = TRUE, main = "Normal") tsplot(palette = "R3", deutan = TRUE, legend = TRUE, main = "Deuteranope") par(mar = c(5, 4, 1, 1)) tsplot(palette = "R4", deutan = FALSE, legend = FALSE) tsplot(palette = "R4", deutan = TRUE, legend = FALSE) tsplot(palette = "Okabe-Ito", deutan = FALSE, legend = FALSE) tsplot(palette = "Okabe-Ito", deutan = TRUE, legend = FALSE) ## Figure 5 -------------------------------------------------------------------- ## See https://www.zeileis.org/news/dorian_rainbow/ ## Figure 6 -------------------------------------------------------------------- specplot(hcl.colors(10, "YlGnBu")) text(-0.05, 0.83, "YlGnBu", pos = 4, xpd = TRUE) specplot(hcl.colors(10, "Viridis")) text(-0.05, 0.83, "Viridis", pos = 4, xpd = TRUE) ## Figure 7 -------------------------------------------------------------------- paletteGrids(list( '"R4"' = palette.colors(palette = "R4"), '"Okabe-Ito"' = palette.colors(palette = "Okabe-Ito"), blank = NULL, blank = NULL, blank = NULL, blank = NULL, '"ggplot2"' = palette.colors(palette = "ggplot2"), '"Tableau 10"' = palette.colors(palette = "Tableau 10"), '"Classic Tableau"' = palette.colors(palette = "Classic Tableau"), blank = NULL, blank = NULL, blank = NULL, '"Set 1"' = palette.colors(palette = "Set 1"), '"Dark 2"' = palette.colors(palette = "Dark 2"), '"Accent"' = palette.colors(palette = "Accent"), '"Set 2"' = palette.colors(palette = "Set 2"), '"Pastel 1"' = palette.colors(palette = "Pastel 1"), '"Paired"' = palette.colors(palette = "Paired"), '"Set 3"' = palette.colors(palette = "Set 3"), '"Pastel 2"' = palette.colors(palette = "Pastel 2"), blank = NULL, blank = NULL, blank = NULL, blank = NULL, '"Alphabet"' = palette.colors(palette = "Alphabet"), '"Polychrome 36"' = palette.colors(palette = "Polychrome 36")), qual = TRUE ) ## Figure 8 -------------------------------------------------------------------- pals <- hcl.pals("qualitative") args <- lapply(pals, function(x) { hcl.colors(8, x) }) names(args) <- paste0('"', pals, '"') args <- c(args[c('"Pastel 1"', '"Dark 2"', '"Set 2"')], list(NULL), args[c('"Dark 3"', '"Set 3"')], list(NULL, NULL, NULL), args[c('"Warm"', '"Cold"', '"Harmonic"')], list(NULL, NULL), args['"Dynamic"']) paletteGrids(args, qual=TRUE) ## Figure 9 -------------------------------------------------------------------- single <- rownames(hcl_palettes("sequential (single-hue)")) pals <- hcl.pals("sequential") singlePals <- pals[pals %in% single] args <- lapply(singlePals, function(x) { hcl.colors(8, x) }) names(args) <- paste0('"', singlePals, '"') args <- c(args[c('"Grays"', '"Blues 3"', '"Purples 3"', '"Light Grays"', '"Blues 2"', '"Purples 2"', '"Reds 3"', '"Greens 3"')], list(NULL), args[c('"Reds 2"', '"Greens 2"', '"Oslo"')]) paletteGrids(args, qual=FALSE) ## Figure 10 ------------------------------------------------------------------- single <- rownames(hcl_palettes("sequential (single-hue)")) pals <- hcl.pals("sequential") multiPals <- pals[! pals %in% single] args <- lapply(multiPals, function(x) { hcl.colors(8, x) }) names(args) <- paste0('"', multiPals, '"') args <- c(args[c('"Red-Blue"', '"Purple-Orange"', '"Green-Yellow"')], args[c('"Red-Purple"', '"Purple-Blue"', '"Terrain"')], args[c('"Red-Yellow"', '"Purple-Yellow"', '"Terrain 2"')], args[c('"Heat"', '"Blue-Yellow"')], list(NULL), args[c('"Heat 2"')], list(NULL, NULL), list(NULL, NULL, NULL), args[c('"Viridis"', '"Inferno"', '"Mako"')], args[c('"Plasma"', '"Rocket"')], list(NULL), list(NULL, NULL, NULL), args[c('"Mint"', '"Peach"', '"Purp"')], args[c('"Dark Mint"', '"OrYel"', '"PurpOr"')], args[c('"Teal"', '"PinkYl"', '"Magenta"')], args[c('"TealGrn"', '"RedOr"', '"Sunset"')], args[c('"BluGrn"', '"Burg"', '"SunsetDark"')], args[c('"Emrld"', '"BurgYl"', '"ag_Sunset"')], args[c('"BluYl"', '"BrwnYl"')], list(NULL), args[c('"ag_GrnYl"')], list(NULL, NULL)) paletteGrids(args, qual=FALSE) ## Figure 11 ------------------------------------------------------------------- single <- rownames(hcl_palettes("sequential (single-hue)")) pals <- hcl.pals("sequential") multiPals <- pals[! pals %in% single] args <- lapply(multiPals, function(x) { hcl.colors(8, x) }) names(args) <- paste0('"', multiPals, '"') args <- c(args[c('"Reds"', '"Greens"', '"Blues"')], args[c('"OrRd"', '"BuGn"', '"PuBu"')], args[c('"Oranges"', '"YlGn"', '"BuPu"')], args[c('"YlOrRd"', '"YlGnBu"', '"Purples"')], args[c('"YlOrBr"', '"GnBu"', '"RdPu"')], list(NULL), args[c('"PuBuGn"', '"PuRd"')], list(NULL, NULL, NULL), args[c('"Lajolla"', '"Hawaii"', '"Batlow"')], args[c('"Turku"')], list(NULL, NULL)) paletteGrids(args, qual=FALSE) ## Figure 12 ------------------------------------------------------------------- specplot(hcl.colors(9, "Purple-Green")) text(-0.05, 0.83, "Purple-Green", pos = 4, xpd = TRUE) specplot(hcl.colors(9, "Fall")) text(-0.05, 0.83, "Fall", pos = 4, xpd = TRUE) ## Figure 13 ------------------------------------------------------------------- pals <- hcl.pals("diverging") args <- lapply(pals, function(x) { hcl.colors(9, x) }) names(args) <- paste0('"', pals, '"') args <- c(args[c('"Green-Orange"', '"Blue-Yellow 3"', '"Cyan-Magenta"', '"Green-Brown"', '"Blue-Yellow 2"', '"Tropic"')], list(NULL, NULL, NULL), args[c('"Blue-Red"', '"Blue-Red 3"', '"Red-Green"', '"Blue-Red 2"', '"Purple-Brown"', '"Purple-Green"')], list(NULL, NULL, NULL), args[c('"Broc"', '"Vik"', '"Lisbon"', '"Cork"', '"Berlin"', '"Tofino"')]) paletteGrids(args, qual=FALSE) ## Figure 14 ------------------------------------------------------------------- pals <- hcl.pals("divergingx") args <- lapply(pals, function(x) { hcl.colors(9, x) }) names(args) <- paste0('"', pals, '"') args <- c(args[c('"Temps"', '"ArmyRose"', '"Fall"')], args[c('"TealRose"', '"Earth"')], list(NULL), args[c('"Geyser"')], list(NULL, NULL), list(NULL, NULL, NULL), args[c('"RdGy"', '"Spectral"', '"PiYG"')], args[c('"RdBu"', '"RdYlBu"', '"PRGn"')], args[c('"PuOr"', '"RdYlGn"', '""')], args[c('"BrBG"', '""', '""')], list(NULL, NULL, NULL), args[c('"Zissou 1"', '"Cividis"', '"Roma"')]) paletteGrids(args, qual=FALSE) ## Figure 15 ------------------------------------------------------------------- image(volcano) boxplot(weight ~ feed, data = chickwts) hist(chickwts$weight)