Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Palette suffixes to prefixes #398

Merged
merged 5 commits into from
Nov 6, 2023
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
14 changes: 14 additions & 0 deletions NAMESPACE
Original file line number Diff line number Diff line change
Expand Up @@ -137,6 +137,20 @@ export(ordinal_english)
export(ordinal_format)
export(ordinal_french)
export(ordinal_spanish)
export(pal_area)
export(pal_brewer)
export(pal_dichromat)
export(pal_div_gradient)
export(pal_gradient_n)
export(pal_grey)
export(pal_hue)
export(pal_identity)
export(pal_linetype)
export(pal_manual)
export(pal_rescale)
export(pal_seq_gradient)
export(pal_shape)
export(pal_viridis)
export(parse_format)
export(percent)
export(percent_format)
Expand Down
2 changes: 2 additions & 0 deletions NEWS.md
Original file line number Diff line number Diff line change
Expand Up @@ -30,6 +30,8 @@
* Correct the domain calculation for `compose_trans()` (@mjskay, #408).
* Transformation objects can optionally include the derivatives of the transform
and the inverse transform (@mjskay, #322).
* Palette functions now have the `pal_`-prefix. The old `_pal`-suffixed versions
are kept for backward compatibility.

# scales 1.2.1

Expand Down
8 changes: 4 additions & 4 deletions R/colour-manip.R
Original file line number Diff line number Diff line change
Expand Up @@ -84,11 +84,11 @@ alpha <- function(colour, alpha = NA) {
#' @importFrom graphics par plot rect text
#' @keywords internal
#' @examples
#' show_col(hue_pal()(9))
#' show_col(hue_pal()(9), borders = NA)
#' show_col(pal_hue()(9))
#' show_col(pal_hue()(9), borders = NA)
#'
#' show_col(viridis_pal()(16))
#' show_col(viridis_pal()(16), labels = FALSE)
#' show_col(pal_viridis()(16))
#' show_col(pal_viridis()(16), labels = FALSE)
show_col <- function(colours, labels = TRUE, borders = NULL, cex_label = 1,
ncol = NULL) {
n <- length(colours)
Expand Down
8 changes: 4 additions & 4 deletions R/colour-mapping.R
Original file line number Diff line number Diff line change
Expand Up @@ -322,14 +322,14 @@ toPaletteFunc.character <- function(pal, alpha, nlevels) {
if (length(pal) == 1 && pal %in% row.names(RColorBrewer::brewer.pal.info)) {
paletteInfo <- RColorBrewer::brewer.pal.info[pal, ]
if (!is.null(nlevels)) {
# brewer_pal will return NAs if you ask for more colors than the palette has
colors <- brewer_pal(palette = pal)(abs(nlevels))
# pal_brewer will return NAs if you ask for more colors than the palette has
colors <- pal_brewer(palette = pal)(abs(nlevels))
colors <- colors[!is.na(colors)]
} else {
colors <- brewer_pal(palette = pal)(RColorBrewer::brewer.pal.info[pal, "maxcolors"]) # Get all colors
colors <- pal_brewer(palette = pal)(RColorBrewer::brewer.pal.info[pal, "maxcolors"]) # Get all colors
}
} else if (length(pal) == 1 && pal %in% c("viridis", "magma", "inferno", "plasma")) {
colors <- viridis_pal(option = pal)(256)
colors <- pal_viridis(option = pal)(256)
} else {
colors <- pal
}
Expand Down
2 changes: 1 addition & 1 deletion R/documentation.R
Original file line number Diff line number Diff line change
Expand Up @@ -9,4 +9,4 @@ seealso <- function(pattern) {

seealso_trans <- function() seealso("_trans$")

seealso_pal <- function() seealso("_pal$")
seealso_pal <- function() seealso("^pal_")
8 changes: 6 additions & 2 deletions R/pal-area.R
Original file line number Diff line number Diff line change
Expand Up @@ -3,14 +3,18 @@
#' @param range Numeric vector of length two, giving range of possible sizes.
#' Should be greater than 0.
#' @export
area_pal <- function(range = c(1, 6)) {
pal_area <- function(range = c(1, 6)) {
force(range)
function(x) rescale(sqrt(x), range, c(0, 1))
}

#' @export
#' @rdname pal_area
area_pal <- pal_area

#' @param max A number representing the maximum size.
#' @export
#' @rdname area_pal
#' @rdname pal_area
abs_area <- function(max) {
force(max)
function(x) rescale(sqrt(abs(x)), c(0, max), c(0, 1))
Expand Down
16 changes: 10 additions & 6 deletions R/pal-brewer.R
Original file line number Diff line number Diff line change
Expand Up @@ -10,14 +10,14 @@
#' @references <https://colorbrewer2.org>
#' @export
#' @examples
#' show_col(brewer_pal()(10))
#' show_col(brewer_pal("div")(5))
#' show_col(brewer_pal(palette = "Greens")(5))
#' show_col(pal_brewer()(10))
#' show_col(pal_brewer("div")(5))
#' show_col(pal_brewer(palette = "Greens")(5))
#'
#' # Can use with gradient_n to create a continuous gradient
#' cols <- brewer_pal("div")(5)
#' show_col(gradient_n_pal(cols)(seq(0, 1, length.out = 30)))
brewer_pal <- function(type = "seq", palette = 1, direction = 1) {
#' cols <- pal_brewer("div")(5)
#' show_col(pal_gradient_n(cols)(seq(0, 1, length.out = 30)))
pal_brewer <- function(type = "seq", palette = 1, direction = 1) {
pal <- pal_name(palette, type)
force(direction)
function(n) {
Expand All @@ -42,6 +42,10 @@ brewer_pal <- function(type = "seq", palette = 1, direction = 1) {
}
}

#' @export
#' @rdname pal_brewer
brewer_pal <- pal_brewer

pal_name <- function(palette, type) {
if (is.character(palette)) {
if (!palette %in% unlist(brewer)) {
Expand Down
14 changes: 9 additions & 5 deletions R/pal-dichromat.R
Original file line number Diff line number Diff line change
Expand Up @@ -5,14 +5,14 @@
#' @export
#' @examples
#' if (requireNamespace("dichromat", quietly = TRUE)) {
#' show_col(dichromat_pal("BluetoOrange.10")(10))
#' show_col(dichromat_pal("BluetoOrange.10")(5))
#' show_col(pal_dichromat("BluetoOrange.10")(10))
#' show_col(pal_dichromat("BluetoOrange.10")(5))
#'
#' # Can use with gradient_n to create a continous gradient
#' cols <- dichromat_pal("DarkRedtoBlue.12")(12)
#' show_col(gradient_n_pal(cols)(seq(0, 1, length.out = 30)))
#' cols <- pal_dichromat("DarkRedtoBlue.12")(12)
#' show_col(pal_gradient_n(cols)(seq(0, 1, length.out = 30)))
#' }
dichromat_pal <- function(name) {
pal_dichromat <- function(name) {
check_installed("dichromat")

if (!any(name == names(dichromat::colorschemes))) {
Expand All @@ -23,6 +23,10 @@ dichromat_pal <- function(name) {
function(n) pal[seq_len(n)]
}

#' @export
#' @rdname pal_dichromat
dichromat_pal <- pal_dichromat


dichromat_schemes <- function() {
if (requireNamespace("dichromat", quietly = TRUE)) {
Expand Down
42 changes: 27 additions & 15 deletions R/pal-gradient.R
Original file line number Diff line number Diff line change
Expand Up @@ -9,9 +9,9 @@
#' other values are deprecated.
#' @export

gradient_n_pal <- function(colours, values = NULL, space = "Lab") {
pal_gradient_n <- function(colours, values = NULL, space = "Lab") {
if (!identical(space, "Lab")) {
lifecycle::deprecate_warn("0.3.0", "gradient_n_pal(space = 'only supports be \"Lab\"')")
lifecycle::deprecate_warn("0.3.0", "pal_gradient_n(space = 'only supports be \"Lab\"')")
}
ramp <- colour_ramp(colours)
force(values)
Expand All @@ -31,41 +31,53 @@ gradient_n_pal <- function(colours, values = NULL, space = "Lab") {
}
}

#' @export
#' @rdname pal_gradient_n
gradient_n_pal <- pal_gradient_n

#' Diverging colour gradient (continuous).
#'
#' @param low colour for low end of gradient.
#' @param mid colour for mid point
#' @param high colour for high end of gradient.
#' @inheritParams gradient_n_pal
#' @inheritParams pal_gradient_n
#' @export
#' @examples
#' x <- seq(-1, 1, length.out = 100)
#' r <- sqrt(outer(x^2, x^2, "+"))
#' image(r, col = div_gradient_pal()(seq(0, 1, length.out = 12)))
#' image(r, col = div_gradient_pal()(seq(0, 1, length.out = 30)))
#' image(r, col = div_gradient_pal()(seq(0, 1, length.out = 100)))
#' image(r, col = pal_div_gradient()(seq(0, 1, length.out = 12)))
#' image(r, col = pal_div_gradient()(seq(0, 1, length.out = 30)))
#' image(r, col = pal_div_gradient()(seq(0, 1, length.out = 100)))
#'
#' library(munsell)
#' pal <- div_gradient_pal(low = mnsl(complement("10R 4/6"), fix = TRUE))
#' pal <- pal_div_gradient(low = mnsl(complement("10R 4/6"), fix = TRUE))
#' image(r, col = pal(seq(0, 1, length.out = 100)))
#' @importFrom munsell mnsl
div_gradient_pal <- function(low = mnsl("10B 4/6"), mid = mnsl("N 8/0"), high = mnsl("10R 4/6"), space = "Lab") {
gradient_n_pal(c(low, mid, high), space = space)
pal_div_gradient <- function(low = mnsl("10B 4/6"), mid = mnsl("N 8/0"), high = mnsl("10R 4/6"), space = "Lab") {
pal_gradient_n(c(low, mid, high), space = space)
}

#' @export
#' @rdname pal_div_gradient
div_gradient_pal <- pal_div_gradient

#' Sequential colour gradient palette (continuous)
#'
#' @param low colour for low end of gradient.
#' @param high colour for high end of gradient.
#' @inheritParams gradient_n_pal
#' @inheritParams pal_gradient_n
#' @export
#' @examples
#' x <- seq(0, 1, length.out = 25)
#' show_col(seq_gradient_pal()(x))
#' show_col(seq_gradient_pal("white", "black")(x))
#' show_col(pal_seq_gradient()(x))
#' show_col(pal_seq_gradient("white", "black")(x))
#'
#' library(munsell)
#' show_col(seq_gradient_pal("white", mnsl("10R 4/6"))(x))
seq_gradient_pal <- function(low = mnsl("10B 4/6"), high = mnsl("10R 4/6"), space = "Lab") {
gradient_n_pal(c(low, high), space = space)
#' show_col(pal_seq_gradient("white", mnsl("10R 4/6"))(x))
pal_seq_gradient <- function(low = mnsl("10B 4/6"), high = mnsl("10R 4/6"), space = "Lab") {
pal_gradient_n(c(low, high), space = space)
}

#' @export
#' @rdname pal_seq_gradient
seq_gradient_pal <- pal_seq_gradient
12 changes: 8 additions & 4 deletions R/pal-grey.R
Original file line number Diff line number Diff line change
Expand Up @@ -2,12 +2,16 @@
#'
#' @param start grey value at low end of palette
#' @param end grey value at high end of palette
#' @seealso [seq_gradient_pal()] for continuous version
#' @seealso [pal_seq_gradient()] for continuous version
#' @export
#' @examples
#' show_col(grey_pal()(25))
#' show_col(grey_pal(0, 1)(25))
grey_pal <- function(start = 0.2, end = 0.8) {
#' show_col(pal_grey()(25))
#' show_col(pal_grey(0, 1)(25))
pal_grey <- function(start = 0.2, end = 0.8) {
force_all(start, end)
function(n) grDevices::grey.colors(n, start = start, end = end)
}

#' @export
#' @rdname pal_grey
grey_pal <- pal_grey
39 changes: 22 additions & 17 deletions R/pal-hue.R
Original file line number Diff line number Diff line change
Expand Up @@ -9,25 +9,25 @@
#' 1 = clockwise, -1 = counter-clockwise
#' @export
#' @examples
#' show_col(hue_pal()(4))
#' show_col(hue_pal()(9))
#' show_col(hue_pal(l = 90)(9))
#' show_col(hue_pal(l = 30)(9))
#' show_col(pal_hue()(4))
#' show_col(pal_hue()(9))
#' show_col(pal_hue(l = 90)(9))
#' show_col(pal_hue(l = 30)(9))
#'
#' show_col(hue_pal()(9))
#' show_col(hue_pal(direction = -1)(9))
#' show_col(hue_pal(h.start = 30)(9))
#' show_col(hue_pal(h.start = 90)(9))
#' show_col(pal_hue()(9))
#' show_col(pal_hue(direction = -1)(9))
#' show_col(pal_hue(h.start = 30)(9))
#' show_col(pal_hue(h.start = 90)(9))
#'
#' show_col(hue_pal()(9))
#' show_col(hue_pal(h = c(0, 90))(9))
#' show_col(hue_pal(h = c(90, 180))(9))
#' show_col(hue_pal(h = c(180, 270))(9))
#' show_col(hue_pal(h = c(270, 360))(9))
hue_pal <- function(h = c(0, 360) + 15, c = 100, l = 65, h.start = 0, direction = 1) {
if (length(h) != 2) cli::cli_abort("{.arg h} must have length 2")
if (length(l) != 1) cli::cli_abort("{.arg l} must have length 1")
if (length(c) != 1) cli::cli_abort("{.arg c} must have length 1")
#' show_col(pal_hue()(9))
#' show_col(pal_hue(h = c(0, 90))(9))
#' show_col(pal_hue(h = c(90, 180))(9))
#' show_col(pal_hue(h = c(180, 270))(9))
#' show_col(pal_hue(h = c(270, 360))(9))
pal_hue <- function(h = c(0, 360) + 15, c = 100, l = 65, h.start = 0, direction = 1) {
if (length(h) != 2) cli::cli_abort("{.arg h} must have length 2.")
if (length(l) != 1) cli::cli_abort("{.arg l} must have length 1.")
if (length(c) != 1) cli::cli_abort("{.arg c} must have length 1.")
force_all(h, c, l, h.start, direction)
function(n) {
if (n == 0) {
Expand All @@ -52,3 +52,8 @@ hue_pal <- function(h = c(0, 360) + 15, c = 100, l = 65, h.start = 0, direction
}
}
}

#' @export
#' @rdname pal_hue
hue_pal <- pal_hue

7 changes: 6 additions & 1 deletion R/pal-identity.R
Original file line number Diff line number Diff line change
Expand Up @@ -3,6 +3,11 @@
#' Leaves values unchanged - useful when the data is already scaled.
#'
#' @export
identity_pal <- function() {
pal_identity <- function() {
function(x) x
}


#' @export
#' @rdname pal_identity
identity_pal <- pal_identity
6 changes: 5 additions & 1 deletion R/pal-linetype.R
Original file line number Diff line number Diff line change
Expand Up @@ -3,7 +3,7 @@
#' Based on a set supplied by Richard Pearson, University of Manchester
#'
#' @export
linetype_pal <- function() {
pal_linetype <- function() {
types <- c(
"solid", "22", "42", "44", "13", "1343", "73", "2262",
"12223242", "F282", "F4448444", "224282F2", "F1"
Expand All @@ -13,3 +13,7 @@ linetype_pal <- function() {
types[seq_len(n)]
}
}

#' @export
#' @rdname pal_linetype
linetype_pal <- pal_linetype
6 changes: 5 additions & 1 deletion R/pal-manual.R
Original file line number Diff line number Diff line change
Expand Up @@ -2,7 +2,7 @@
#'
#' @param values vector of values to be used as a palette.
#' @export
manual_pal <- function(values) {
pal_manual <- function(values) {
force(values)
function(n) {
n_values <- length(values)
Expand All @@ -12,3 +12,7 @@ manual_pal <- function(values) {
unname(values[seq_len(n)])
}
}

#' @export
#' @rdname pal_manual
manual_pal <- pal_manual
6 changes: 5 additions & 1 deletion R/pal-rescale.R
Original file line number Diff line number Diff line change
Expand Up @@ -6,9 +6,13 @@
#' @param range Numeric vector of length two, giving range of possible
#' values. Should be between 0 and 1.
#' @export
rescale_pal <- function(range = c(0.1, 1)) {
pal_rescale <- function(range = c(0.1, 1)) {
force(range)
function(x) {
rescale(x, range, c(0, 1))
}
}

#' @export
#' @rdname pal_rescale
rescale_pal <- pal_rescale
6 changes: 5 additions & 1 deletion R/pal-shape.R → R/pal-shape.r
Original file line number Diff line number Diff line change
Expand Up @@ -2,7 +2,7 @@
#'
#' @param solid should shapes be solid or not?
#' @export
shape_pal <- function(solid = TRUE) {
pal_shape <- function(solid = TRUE) {
force(solid)
function(n) {
if (n > 6) {
Expand All @@ -19,3 +19,7 @@ shape_pal <- function(solid = TRUE) {
}
}
}

#' @export
#' @rdname pal_shape
shape_pal <- pal_shape
Loading
Loading