Skip to content

Commit

Permalink
new default palette(); new predefined palette()s; new palette.pals() …
Browse files Browse the repository at this point in the history 
…and palette.colors(); minor change to panel.smooth() defaults

git-svn-id: https://svn.r-project.org/R/trunk@77336 00db46b3-68df-0310-9c12-caf00c1e9a41
  • Loading branch information
murrell committed Oct 30, 2019
1 parent a7fd2f4 commit 58eafa7
Show file tree
Hide file tree
Showing 9 changed files with 380 additions and 129 deletions.
8 changes: 8 additions & 0 deletions doc/NEWS.Rd
View file
Original file line number Diff line number Diff line change
Expand Up @@ -118,6 +118,14 @@
\item \code{normalizePath()} on Windows now resolves symbolic links
and normalizes case of long names of path elements in case-insensitive
folders (\PR{17165}).

\item The \code{palette()} function has a new default set of
colours (which are less saturated and have better accessibility
properties). There are also some new built-in palettes, which
are listed by the new \code{palette.pals()} function. These
include the old default palette under the name \code{"R3"}. Finally,
the new \code{palette.colors()} function allows a subset of
colours to be selected from any of the built-in palettes.
}
}

Expand Down
3 changes: 2 additions & 1 deletion src/library/grDevices/NAMESPACE
View file
Original file line number Diff line number Diff line change
Expand Up @@ -13,7 +13,8 @@ export(Hershey, adjustcolor, as.graphicsAnnot, as.raster, axisTicks,
grSoftVersion, grey.colors, heat.colors, hsv, hcl, hcl.colors, hcl.pals,
is.raster,
make.rgb, n2mfrow, nclass.Sturges, nclass.FD, nclass.scott,
palette, pdf, pdf.options, pdfFonts, pictex, postscript,
palette, palette.pals, palette.colors,
pdf, pdf.options, pdfFonts, pictex, postscript,
postscriptFonts, ps.options, rainbow, recordGraphics,
recordPlot, replayPlot, rgb, rgb2hsv, savePlot, setEPS,
setGraphicsEventEnv, setGraphicsEventHandlers, setPS,
Expand Down
180 changes: 167 additions & 13 deletions src/library/grDevices/R/colorstuff.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -72,19 +72,6 @@ rgb2hsv <- function(r, g = NULL, b = NULL, maxColorValue = 255)
.Call(C_RGB2hsv, rgb)
}

palette <- function(value)
{
if(missing(value)) .Call(C_palette, character())
else invisible(.Call.graphics(C_palette, value))
}

## An unexported version that works with internal representation as 'rcolor'
## We could avoid this if we knew at R level whether the display list was
## enabled or inhibited: but we do need to record a call to C_palette2.
recordPalette <- function()
.Call.graphics(C_palette2, .Call(C_palette2, NULL))


## A quick little ''rainbow'' function -- improved by MM
## doc in ../man/palettes.Rd
rainbow <- function (n, s = 1, v = 1, start = 0, end = max(1,n - 1)/n,
Expand Down Expand Up @@ -184,3 +171,170 @@ gray.colors <- function(n, start = 0.3, end = 0.9, gamma = 2.2, alpha = NULL,
}

grey.colors <- gray.colors

palette <- function (value)
{
## if value missing return current palette (visibly)
if (missing(value)) return(.Call(grDevices:::C_palette, character()))

## in case value is just a single string, select the corresponding set
## colors with "default" handled at C level
if (length(value) == 1L && value != "default") {
fx <- function(x) tolower(gsub("[-, _, \\,, (, ), \\ , \\.]", "", x))
n <- charmatch(fx(value), fx(names(.palette_colors_hex)))
if (!is.na(n)) value <- .palette_colors_hex[[n]]
}

## set new palette value, return old one invisibly
## if a .Device is open, record the .Call.graphics
if (.Device == "null device") {
invisible(.Call(grDevices:::C_palette, value))
} else {
invisible(.Call.graphics(grDevices:::C_palette, value))
}

}

## palette.colors() is a function for accessing the colors behind palette()
## directly. palette.pals() shows the available names (a la hcl.pals()).
palette.pals <- function() names(.palette_colors_hex)

palette.colors <- function(n = NULL, palette = "Okabe-Ito", alpha = 1)
{
## number of colors
if (!is.null(n)) {
n <- as.integer(n[1L])
if (n < 1L) return(character())
}

## match palette name
fx <- function(x) tolower(gsub("[-, _, \\,, (, ), \\ , \\.]", "", x))
p <- charmatch(fx(palette), fx(names(.palette_colors_hex)))
if (is.na(p)) stop("'palette' does not match any given palette")
if (p < 1L) stop("'palette' is ambiguous")

## select n colors from palette
cols <- .palette_colors_hex[[p]]
if (is.null(n)) n <- length(cols)
if (n > length(cols)) {
n <- length(cols)
warning(sprintf("'n' set to %s, the maximum available for %s palette",
n, palette))
}
cols <- cols[seq_len(n)]

## add alpha if specified
if (!missing(alpha) || is.null(alpha)) {
alpha <- format(as.hexmode(round(alpha * 255 + 0.0001)),
width = 2L, upper.case = TRUE)
cols <- paste0(cols, alpha)
}

return(cols)
}

## underlying hex codes for palette color sets
.palette_colors_hex <- list(
## default in R <= 3.6.x
"R3" = c("#000000", "#FF0000", "#00CD00", "#0000FF",
"#00FFFF", "#FF00FF", "#FFFF00", "#BEBEBE"),
## rgb(
## r = c(0, 255, 0, 0, 0, 255, 255, 190),
## g = c(0, 0, 205, 0, 255, 0, 255, 190),
## b = c(0, 0, 0, 255, 255, 255, 0, 190),
## maxColorValue = 255
## ),

## new default in R >= 4.0.0
"R4" = c("#000000", "#DF536B", "#61D04F", "#13A5FD",
"#33DBDF", "#D03AF5", "#EEC21F", "#9E9E9E"),
## hcl(
## h = c(0, 5, 125, 245, 195, 295, 65, 0),
## c = c(0, 100, 90, 95, 60, 120, 90, 0),
## l = c(0, 55, 75, 65, 80, 55, 80, 65)
## ),

## scales::hue_pal (Hadley Wickham)
## re-ordered for RGBCMY plus black/gray
"ggplot2" = c("#000000", "#F8766D", "#00BA38", "#619CFF",
"#00BFC4", "#F564E3", "#B79F00", "#9E9E9E"),
## hcl(
## h = c(0, 15, 135, 255, 195, 315, 75, 0),
## c = c(0, 100, 100, 100, 100, 100, 100, 0),
## l = c(0, 65, 65, 65, 65, 65, 65, 65)
## ),

## Masataka Okabe & Kei Ito
## http://jfly.iam.u-tokyo.ac.jp/color/
"Okabe-Ito" = c(black = "#000000", orange = "#E69F00", skyblue = "#56B4E9",
bluishgreen = "#009E73", yellow = "#F0E442", blue = "#0072B2",
vermillion = "#D55E00", reddishpurple = "#CC79A7", gray = "#999999"),

## ColorBrewer.org (Mark A. Harrower & Cynthia A. Brewer)
## http://ColorBrewer2.org/
"Accent" = c("#7FC97F", "#BEAED4", "#FDC086", "#FFFF99", "#386CB0",
"#F0027F", "#BF5B17", "#666666"),
"Dark 2" = c("#1B9E77", "#D95F02", "#7570B3", "#E7298A", "#66A61E",
"#E6AB02", "#A6761D", "#666666"),
"Paired" = c("#A6CEE3", "#1F78B4", "#B2DF8A", "#33A02C", "#FB9A99",
"#E31A1C", "#FDBF6F", "#FF7F00", "#CAB2D6", "#6A3D9A"),
"Pastel 1" = c("#FBB4AE", "#B3CDE3", "#CCEBC5", "#DECBE4", "#FED9A6",
"#FFFFCC", "#E5D8BD", "#FDDAEC", "#F2F2F2"),
"Pastel 2" = c("#B3E2CD", "#FDCDAC", "#CBD5E8", "#F4CAE4", "#E6F5C9",
"#FFF2AE", "#F1E2CC", "#CCCCCC"),
"Set 1" = c("#E41A1C", "#377EB8", "#4DAF4A", "#984EA3", "#FF7F00",
"#FFFF33", "#A65628", "#F781BF", "#999999"),
"Set 2" = c("#66C2A5", "#FC8D62", "#8DA0CB", "#E78AC3", "#A6D854",
"#FFD92F", "#E5C494", "#B3B3B3"),
"Set 3" = c("#8DD3C7", "#FFFFB3", "#BEBADA", "#FB8072", "#80B1D3",
"#FDB462", "#B3DE69", "#FCCDE5", "#D9D9D9", "#BC80BD"),

## Tableau 10 (Maureen Stone & Cristy Miller)
## https://www.tableau.com/about/blog/2016/7/colors-upgrade-tableau-10-56782
"Tableau 10" = c(blue = "#4E79A7", orange = "#F28E2B", red = "#E15759",
lightteal = "#76B7B2", green = "#59A14F", yellow = "#EDC948",
purple = "#B07AA1", pink = "#FF9DA7", brown = "#9C755F",
lightgray = "#BAB0AC"),
"Classic Tableau" = c("#1F77B4", "#FF7F0E", "#2CA02C", "#D62728", "#9467BD",
"#8C564B", "#E377C2", "#7F7F7F", "#BCBD22", "#17BECF"),

## Polychrome
## (Kevin R. Coombes, Guy Brock, Zachary B. Abrams, Lynne V. Abruzzo)
## https://doi.org/10.18637/jss.v090.c01
"Polychrome 36" = c(darkpurplishgray = "#5A5156", purplishwhite = "#E4E1E3",
vividred = "#F6222E", vividpurple = "#FE00FA",
vividyellowishgreen = "#16FF32",
strongpurplishblue = "#3283FE", vividorangeyellow = "#FEAF16",
vividpurplishred = "#B00068", brilliantgreen = "#1CFFCE",
vividyellowgreen = "#90AD1C", vividblue = "#2ED9FF",
brilliantpurple = "#DEA0FD",
vividviolet = "#AA0DFE", strongpink = "#F8A19F", strongblue = "#325A9B",
strongreddishorange = "#C4451C", vividgreen = "#1C8356",
lightolivebrown = "#85660D", vividreddishpurple = "#B10DA1",
vividgreenishyellow = "#FBE426", vividyellowishgreen = "#1CBE4F",
vividred = "#FA0087", vividpurplishred = "#FC1CBF",
paleyellow = "#F7E1A0",
strongreddishpurple = "#C075A6", vividviolet = "#782AB6",
vividyellowgreen = "#AAF400", verylightblue = "#BDCDFF",
strongreddishbrown = "#822E1C", verylightyellowishgreen = "#B5EFB5",
verylightbluishgreen = "#7ED7D1", deepgreenishblue = "#1C7F93",
vividpurple = "#D85FF7", deeppurple = "#683B79",
brilliantblue = "#66B0FF",
vividviolet = "#3B00FB"),
"Alphabet" = c(amethyst = "#AA0DFE", blue = "#3283FE", caramel = "#85660D",
damson = "#782AB6", ebony = "#565656", forest = "#1C8356",
green = "#16FF32", honey = "#F7E1A0", iron = "#E2E2E2",
jade = "#1CBE4F", kingcrab = "#C4451C", lavender = "#DEA0FD",
magenta = "#FE00FA", navy = "#325A9B", orange = "#FEAF16",
pink = "#F8A19F", quagmire = "#90AD1C", red = "#F6222E",
sea = "#1CFFCE", turquoise = "#2ED9FF", ultraviolet = "#B10DA1",
violet = "#C075A6", wine = "#FC1CBF", xanthin = "#B00068",
yellow = "#FBE426", zinnia = "#FA0087")
)

## An unexported version that works with internal representation as 'rcolor'
## We could avoid this if we knew at R level whether the display list was
## enabled or inhibited: but we do need to record a call to C_palette2.
recordPalette <- function()
.Call.graphics(C_palette2, .Call(C_palette2, NULL))

49 changes: 41 additions & 8 deletions src/library/grDevices/man/palette.Rd
View file
Original file line number Diff line number Diff line change
Expand Up @@ -4,13 +4,21 @@
% Distributed under GPL 2 or later

\name{palette}
\alias{palette}
\alias{palette.pals}
\alias{palette.colors}
\title{Set or View the Graphics Palette}
\usage{
palette(value)
palette.pals()
palette.colors(n = NULL, palette = "Okabe-Ito", alpha = 1)
}
\alias{palette}
\arguments{
\item{value}{an optional character vector.}
\item{value}{an optional character vector specifying a new palette
(see Details).}
\item{n}{the number of colors to select from a palette.}
\item{palette}{a valid palette name (one of \code{palette.pals()}).}
\item{alpha}{an alpha-transparency level.}
}
\description{
View or manipulate the color palette which is used when a \code{col=}
Expand All @@ -22,15 +30,17 @@ palette(value)
it is almost always better to specify colours by name.

If \code{value} has length 1, it is taken to be the name of a built-in
color palette (only \code{"default"} is built-in currently). If
\code{value} has length greater than 1 it is assumed to contain a
description of the colors which are to make up the new palette (either
by name or by RGB levels). The maximum size for a palette is 1024
color palette. The available palette names are returned by
\code{palette.pals()}. It is also possible to specify \code{"default"}.

If \code{value} has length greater than 1 it is assumed to contain a
description of the colors which are to make up the new palette.
The maximum size for a palette is 1024
entries.

If \code{value} is omitted, no change is made to the current palette.

There is only one palette setting for all devices in a \R session. If
There is only one palette setting for all devices in an \R session. If
the palette is changed, the new palette applies to all subsequent
plotting.

Expand All @@ -41,7 +51,8 @@ palette(value)
}

\value{
A character vector giving the palette which \emph{was} in effect.
A character vector giving the colors from the
palette which \emph{was} in effect.
This is \code{\link{invisible}} unless the argument is omitted.
}
\seealso{
Expand Down Expand Up @@ -74,6 +85,28 @@ plot (xy, lwd = 2,
main = "Alpha-Transparency Palette\n alpha = 0.3")
xy[,1] <- -xy[,1]
points(xy, col = 8, pch = 16, cex = 1.5)
palette("default")

## List available built-in palettes
palette.pals()

## Demonstrate the colors 1:8 in different palettes using a custom matplot()
sinplot <- function() {
x <- outer(
seq(-pi, pi, length.out = 50),
seq(0, pi, length.out = 8),
function(x, y) sin(x - y)
)
matplot(x, type = "l", lwd = 4, lty = 1, col = 1:8, ylab = "")
}
sinplot()
palette("R3")
sinplot()
palette("Okabe-Ito")
sinplot()
palette("Tableau")
sinplot()

palette("default")
}
\keyword{color}
Expand Down
41 changes: 18 additions & 23 deletions src/library/grDevices/src/colors.c
View file
Original file line number Diff line number Diff line change
Expand Up @@ -595,13 +595,13 @@ SEXP col2rgb(SEXP colors, SEXP alpha)
static int PaletteSize = 8;
static rcolor Palette[MAX_PALETTE_SIZE] = {
0xff000000,
0xff0000ff,
0xff00cd00,
0xffff0000,
0xffffff00,
0xffff00ff,
0xff00ffff,
0xffbebebe
0xff6b53df,
0xff4fd061,
0xfffda513,
0xffdfdb33,
0xfff53ad0,
0xff1fc2ee,
0xff656565
};

static rcolor Palette0[MAX_PALETTE_SIZE];
Expand Down Expand Up @@ -640,21 +640,16 @@ static int StrMatch(const char *s, const char *t)
*/

/* Default Color Palette */
/* Paul Murrell 05/06/02 (2002, probably)
* Changed "white" to "grey" in the default palette
* in response to user suggestion
*/
attribute_hidden
const char *DefaultPalette[] = {
"black",
"red",
"green3",
"blue",
"cyan",
"magenta",
"yellow",
"grey",
NULL
const rcolor DefaultPalette[8] = {
0xff000000,
0xff6b53df,
0xff4fd061,
0xfffda513,
0xffdfdb33,
0xfff53ad0,
0xff1fc2ee,
0xff656565
};

/* The Table of Known Color Names */
Expand Down Expand Up @@ -1502,8 +1497,8 @@ SEXP palette(SEXP val)
if ((n = length(val)) == 1) {
if (StrMatch("default", CHAR(STRING_ELT(val, 0)))) {
int i;
for (i = 0; (i < MAX_PALETTE_SIZE) && DefaultPalette[i]; i++)
Palette[i] = name2col(DefaultPalette[i]);
for (i = 0; i < 8; i++)
Palette[i] = DefaultPalette[i];
PaletteSize = i;
} else error(_("unknown palette (need >= 2 colors)"));
}
Expand Down
2 changes: 1 addition & 1 deletion src/library/graphics/R/coplot.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -36,7 +36,7 @@ co.intervals <- function (x, number = 6, overlap = 0.5)
}

panel.smooth <- function(x, y, col = par("col"), bg = NA, pch = par("pch"),
cex = 1, col.smooth = "red", span = 2/3, iter = 3, ...)
cex = 1, col.smooth = 2, span = 2/3, iter = 3, ...)
{
points(x, y, pch=pch, col=col, bg=bg, cex=cex)
ok <- is.finite(x) & is.finite(y)
Expand Down
4 changes: 2 additions & 2 deletions src/library/graphics/man/panel.smooth.Rd
View file
Original file line number Diff line number Diff line change
Expand Up @@ -12,7 +12,7 @@
}
\usage{
panel.smooth(x, y, col = par("col"), bg = NA, pch = par("pch"),
cex = 1, col.smooth = "red", span = 2/3, iter = 3,
cex = 1, col.smooth = 2, span = 2/3, iter = 3,
\dots)
}
\arguments{
Expand All @@ -34,7 +34,7 @@ panel.smooth(x, y, col = par("col"), bg = NA, pch = par("pch"),
}
\examples{
pairs(swiss, panel = panel.smooth, pch = ".") # emphasize the smooths
pairs(swiss, panel = panel.smooth, lwd = 2, cex = 1.5, col = "blue") # hmm...
pairs(swiss, panel = panel.smooth, lwd = 2, cex = 1.5, col = 4) # hmm...
}
\keyword{hplot}
\keyword{dplot}

0 comments on commit 58eafa7

Please sign in to comment.