Skip to content

Commit

Permalink
Merge pull request #72 from jfisher-usgs/master
Browse files Browse the repository at this point in the history 
Merge with upstream
  • Loading branch information
@jfisher-usgs
jfisher-usgs authored Jul 14, 2018
2 parents 8828d22 + cd9796c commit c83f78b
Show file tree
Hide file tree
Showing 4 changed files with 156 additions and 53 deletions.
2 changes: 1 addition & 1 deletion DESCRIPTION
View file
Original file line number Diff line number Diff line change
@@ -1,6 +1,6 @@
Package: inlmisc
Title: Miscellaneous Functions for the USGS INL Project Office
Version: 0.4.1
Version: 0.4.2
Authors@R: person(given=c("Jason", "C."), family="Fisher", role=c("aut", "cre"), email="[email protected]", comment=c(ORCID="0000-0001-9032-8912"))
Description: A collection of functions for creating high-level graphics,
performing raster-based analysis, processing MODFLOW-based models,
Expand Down
4 changes: 3 additions & 1 deletion NEWS.md
View file
Original file line number Diff line number Diff line change
@@ -1,4 +1,6 @@
# inlmisc 0.4.1
# inlmisc 0.4.2

- In `GetTolColors` function, revise color schemes based on issue 3.0 of technical note.

- In `PlotGraph` function, improve placement of tick marks.

Expand Down
166 changes: 127 additions & 39 deletions R/GetTolColors.R
View file
Original file line number Diff line number Diff line change
@@ -1,72 +1,160 @@
#' Color Palette for Qualitative Data
#' Tol Color Palettes
#'
#' This function creates a vector of \code{n} contiguous colors from color schemes by Paul Tol (2012).
#' This function creates a vector of \code{n} contiguous colors from
#' color schemes by Paul Tol (2018).
#'
#' @param n 'integer'.
#' Number of colors to be in the palette, the maximum is 21.
#' Number of colors to be in the palette, the maximum value is based on the specified color scheme.
#' @param scheme 'character'.
#' Color scheme: select
#' \code{"bright"}, \code{"vibrant"}, \code{"muted"}, or \code{"light"} for sequential colors; and
#' \code{"rainbow"} for discrete colors.
#' Where \code{n < 8} for \code{"bright"} and \code{"vibrant"},
#' \code{n < 10} for \code{"muted"} and \code{"light"}, and
#' \code{n < 24} for \code{"rainbow"}.
#' @param alpha 'numeric'.
#' Alpha transparency, parameter values range from 0 (fully transparent) to 1 (fully opaque).
#' Alpha transparency, values range from 0 (fully transparent) to 1 (fully opaque).
#' Specify as \code{NULL} to exclude the alpha channel color component.
#' @param plot 'logical'.
#' Whether to display the color palette.
#'
#' @return Returns a 'character' vector of length \code{n} with elements of 7 or 9 characters,
#' "#" followed by the red, blue, green, and optionally alpha values in hexadecimal.
#' \code{"#"} followed by the red, blue, green, and optionally alpha values in hexadecimal.
#'
#' @author J.C. Fisher, U.S. Geological Survey, Idaho Water Science Center
#'
#' @references
#' Tol, Paul, 2012, Colour Schemes:
#' SRON Technical Note, doc. no. SRON/EPS/TN/09-002, issue 2.2, 16 p.,
#' accesed January 26, 2018 at \url{https://personal.sron.nl/~pault/colourschemes.pdf}.
#' Tol, Paul, 2018, Colour Schemes:
#' SRON Technical Note, doc. no. SRON/EPS/TN/09-002, issue 3.0, 17 p.,
#' accessed July 18, 2018 at \url{https://personal.sron.nl/~pault/data/colourschemes.pdf}.
#'
#' @keywords color
#'
#' @export
#'
#' @examples
#' op <- par(mfrow = c(2, 1), oma = c(1, 1, 1, 1))
#' GetTolColors(7, plot = TRUE)
#' GetTolColors(21, alpha = 0.85, plot = TRUE)
#' op <- par(mfrow = c(5, 1), oma = c(0, 0, 0, 0), mai = c(0.4, 0, 0.4, 0))
#' GetTolColors( 7, scheme = "bright", plot = TRUE)
#' GetTolColors( 7, scheme = "vibrant", plot = TRUE)
#' GetTolColors( 9, scheme = "muted", plot = TRUE)
#' GetTolColors( 9, scheme = "light", plot = TRUE)
#' GetTolColors(23, scheme = "rainbow", plot = TRUE)
#' par(op)
#'

GetTolColors <- function(n, alpha=1, plot=FALSE) {
GetTolColors <- function(n, scheme=c("bright", "vibrant", "muted", "light", "rainbow"),
alpha=NULL, plot=FALSE) {

checkmate::assertInt(n, lower=1, upper=21)
scheme <- match.arg(scheme)
nmax <- c("bright"=7, "vibrant"=7, "muted"=9, "light"=9, "rainbow"=23)
checkmate::assertInt(n, lower=1, upper=nmax[scheme])
checkmate::assertNumber(alpha, lower=0, upper=1, finite=TRUE, null.ok=TRUE)
checkmate::assertFlag(plot)

# color schemes copied from Peter Carl's blog post, accessed January 26, 2018 at
# https://tradeblotter.wordpress.com/2013/02/28/the-paul-tol-21-color-salute/
pal <- list(c("#4477AA"),
c("#4477AA", "#CC6677"),
c("#4477AA", "#DDCC77", "#CC6677"),
c("#4477AA", "#117733", "#DDCC77", "#CC6677"),
c("#332288", "#88CCEE", "#117733", "#DDCC77", "#CC6677"),
c("#332288", "#88CCEE", "#117733", "#DDCC77", "#CC6677", "#AA4499"),
c("#332288", "#88CCEE", "#44AA99", "#117733", "#DDCC77", "#CC6677", "#AA4499"),
c("#332288", "#88CCEE", "#44AA99", "#117733", "#999933", "#DDCC77", "#CC6677", "#AA4499"),
c("#332288", "#88CCEE", "#44AA99", "#117733", "#999933", "#DDCC77", "#CC6677", "#882255", "#AA4499"),
c("#332288", "#88CCEE", "#44AA99", "#117733", "#999933", "#DDCC77", "#661100", "#CC6677", "#882255", "#AA4499"),
c("#332288", "#6699CC", "#88CCEE", "#44AA99", "#117733", "#999933", "#DDCC77", "#661100", "#CC6677", "#882255", "#AA4499"),
c("#332288", "#6699CC", "#88CCEE", "#44AA99", "#117733", "#999933", "#DDCC77", "#661100", "#CC6677", "#AA4466", "#882255", "#AA4499"),
c("#882E72", "#B178A6", "#D6C1DE", "#1965B0", "#5289C7", "#7BAFDE", "#4EB265", "#90C987", "#CAE0AB", "#F7EE55", "#F6C141", "#F1932D", "#E8601C"),
c("#882E72", "#B178A6", "#D6C1DE", "#1965B0", "#5289C7", "#7BAFDE", "#4EB265", "#90C987", "#CAE0AB", "#F7EE55", "#F6C141", "#F1932D", "#E8601C", "#DC050C"),
c("#114477", "#4477AA", "#77AADD", "#117755", "#44AA88", "#99CCBB", "#777711", "#AAAA44", "#DDDD77", "#771111", "#AA4444", "#DD7777", "#771144", "#AA4477", "#DD77AA"),
c("#771155", "#AA4488", "#CC99BB", "#114477", "#4477AA", "#77AADD", "#117777", "#44AAAA", "#77CCCC", "#777711", "#AAAA44", "#DDDD77", "#774411", "#AA7744", "#DDAA77", "#771122"),
c("#771155", "#AA4488", "#CC99BB", "#114477", "#4477AA", "#77AADD", "#117777", "#44AAAA", "#77CCCC", "#777711", "#AAAA44", "#DDDD77", "#774411", "#AA7744", "#DDAA77", "#771122", "#AA4455"),
c("#771155", "#AA4488", "#CC99BB", "#114477", "#4477AA", "#77AADD", "#117777", "#44AAAA", "#77CCCC", "#777711", "#AAAA44", "#DDDD77", "#774411", "#AA7744", "#DDAA77", "#771122", "#AA4455", "#DD7788"),
c("#771155", "#AA4488", "#CC99BB", "#114477", "#4477AA", "#77AADD", "#117777", "#44AAAA", "#77CCCC", "#117744", "#44AA77", "#88CCAA", "#777711", "#AAAA44", "#DDDD77", "#774411", "#AA7744", "#DDAA77", "#771122"),
c("#771155", "#AA4488", "#CC99BB", "#114477", "#4477AA", "#77AADD", "#117777", "#44AAAA", "#77CCCC", "#117744", "#44AA77", "#88CCAA", "#777711", "#AAAA44", "#DDDD77", "#774411", "#AA7744", "#DDAA77", "#771122", "#AA4455"),
c("#771155", "#AA4488", "#CC99BB", "#114477", "#4477AA", "#77AADD", "#117777", "#44AAAA", "#77CCCC", "#117744", "#44AA77", "#88CCAA", "#777711", "#AAAA44", "#DDDD77", "#774411", "#AA7744", "#DDAA77", "#771122", "#AA4455", "#DD7788"))
col <- pal[[n]]
if (scheme == "bright") {
pal <- c("blue" = "#4477AA",
"red" = "#EE6677",
"green" = "#228833",
"yellow" = "#CCBB44",
"cyan" = "#66CCEE",
"purple" = "#AA3377",
"grey" = "#BBBBBB")
} else if (scheme == "vibrant") {
pal <- c("orange" = "#EE7733",
"blue" = "#0077BB",
"cyan" = "#33BBEE",
"magenta" = "#EE3377",
"red" = "#CC3311",
"teal" = "#009988",
"grey" = "#BBBBBB")
} else if (scheme == "muted") {
pal <- c("rose" = "#CC6677",
"indigo" = "#332288",
"sand" = "#DDCC77",
"green" = "#117733",
"cyan" = "#88CCEE",
"wine" = "#882255",
"teal" = "#44AA99",
"olive" = "#999933",
"purple" = "#AA4499")
} else if (scheme == "light") {
pal <- c("libht blue" = "#77AADD",
"orange" = "#EE8866",
"light yellow" = "#EEDD88",
"pink" = "#FFAABB",
"light cyan" = "#99DDFF",
"mint" = "#44BB99",
"pear" = "#BBCC33",
"olive" = "#AAAA00",
"pale grey" = "#DDDDDD")
} else if (scheme == "rainbow") {
pal <- c("1" = "#E8ECFB",
"2" = "#D9CCE3",
"3" = "#D1BBD7",
"4" = "#CAACCB",
"5" = "#BA8DB4",
"6" = "#AE76A3",
"7" = "#AA6F9E",
"8" = "#994F88",
"9" = "#882E72",
"10" = "#1965B0",
"11" = "#437DBF",
"12" = "#5289C7",
"13" = "#6195CF",
"14" = "#7BAFDE",
"15" = "#4EB265",
"16" = "#90C987",
"17" = "#CAE0AB",
"18" = "#F7F056",
"19" = "#F7CB45",
"20" = "#F6C141",
"21" = "#F4A736",
"22" = "#F1932D",
"23" = "#EE8026",
"24" = "#E8601C",
"25" = "#E65518",
"26" = "#DC050C",
"27" = "#A5170E",
"28" = "#72190E",
"29" = "#42150A")
idx <- list(c(10),
c(10, 26),
c(10, 18, 26),
c(10, 15, 18, 26),
c(10, 14, 15, 18, 26),
c(10, 14, 15, 17, 18, 26),
c( 9, 10, 14, 15, 17, 18, 26),
c( 9, 10, 14, 15, 17, 18, 23, 26),
c( 9, 10, 14, 15, 17, 18, 23, 26, 28),
c( 9, 10, 14, 15, 17, 18, 21, 24, 26, 28),
c( 9, 10, 12, 14, 15, 17, 18, 21, 24, 26, 28),
c( 3, 6, 9, 10, 12, 14, 15, 17, 18, 21, 24, 26),
c( 3, 6, 9, 10, 12, 14, 15, 16, 17, 18, 21, 24, 26),
c( 3, 6, 9, 10, 12, 14, 15, 16, 17, 18, 20, 22, 24, 26),
c( 3, 6, 9, 10, 12, 14, 15, 16, 17, 18, 20, 22, 24, 26, 28),
c( 3, 5, 7, 9, 10, 12, 14, 15, 16, 17, 18, 20, 22, 24, 26, 28),
c( 3, 5, 7, 8, 9, 10, 12, 14, 15, 16, 17, 18, 20, 22, 24, 26, 28),
c( 3, 5, 7, 8, 9, 10, 12, 14, 15, 16, 17, 18, 20, 22, 24, 26, 27, 28),
c( 2, 4, 5, 7, 8, 9, 10, 12, 14, 15, 16, 17, 18, 20, 22, 24, 26, 27, 28),
c( 2, 4, 5, 7, 8, 9, 10, 11, 13, 14, 15, 16, 17, 18, 20, 22, 24, 26, 27, 28),
c( 2, 4, 5, 7, 8, 9, 10, 11, 13, 14, 15, 16, 17, 18, 19, 21, 23, 25, 26, 27, 28),
c( 2, 4, 5, 7, 8, 9, 10, 11, 13, 14, 15, 16, 17, 18, 19, 21, 23, 25, 26, 27, 28, 29),
c( 1, 2, 4, 5, 7, 8, 9, 10, 11, 13, 14, 15, 16, 17, 18, 19, 21, 23, 25, 26, 27, 28, 29))
}

col <- if (scheme == "rainbow") pal[idx[[n]]] else pal[1:n]

if (is.finite(alpha)) col <- grDevices::adjustcolor(col, alpha.f=alpha)
if (!is.null(alpha)) {
col <- grDevices::adjustcolor(col, alpha.f=alpha)
names(col) <- names(pal)[1:n]
}

if (plot) {
graphics::plot.default(0, 0, type="n", xlim=c(0, 1), ylim=c(0, 1), axes=FALSE, xlab="", ylab="")
graphics::plot.default(0, 0, type="n", xlim=c(0, 1), ylim=c(0, 1),
axes=FALSE, xlab="", ylab="", main=scheme)
graphics::rect(0:(n - 1) / n, 0, 1:n / n, 1, col=col, border="#D3D3D3")
at <- 0:(n - 1) / n + (1 / (2 * n))
graphics::axis(1, at=at, labels=names(col), tick=FALSE)
}

return(col)
Expand Down
37 changes: 25 additions & 12 deletions man/GetTolColors.Rd
View file

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

0 comments on commit c83f78b

Please sign in to comment.