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

Feature: encode_colour() and _native() allow na_value #38

Open
wants to merge 14 commits into
base: main
Choose a base branch
from
Open
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
2 changes: 1 addition & 1 deletion DESCRIPTION
Original file line number Diff line number Diff line change
Expand Up @@ -27,6 +27,6 @@ Suggests:
testthat (>= 3.0.0)
Encoding: UTF-8
Roxygen: list(markdown=TRUE)
RoxygenNote: 7.2.0
RoxygenNote: 7.2.1
SystemRequirements: C++11
Config/testthat/edition: 3
12 changes: 12 additions & 0 deletions NEWS.md
Original file line number Diff line number Diff line change
@@ -1,5 +1,17 @@
# farver (development version)

* `encode_colour()` and `encode_native()` also accept a list of channel vectors.
If you compute your channels independently you don't need to `cbind()` them into
a contiguous matrix anymore, but rather you can `list()` them (#36, @zeehio).

* `encode_native()` is faster now. It avoids going through an intermediate character
vector representation (#37, @zeehio).

* `encode_colour()` and `encode_native()` accept a `na_value` argument to specify
a color that can be used as a fallback if the color to convert contains `NA`s
or it can not be represented in the RGB space. (#38, @zeehio)


# farver 2.1.1

* Added input checking to a range of functions to guard against segfaults with
Expand Down
51 changes: 44 additions & 7 deletions R/encode.R
Original file line number Diff line number Diff line change
Expand Up @@ -6,7 +6,11 @@
#'
#' @inheritSection convert_colour Handling of non-finite and out of bounds values
#'
#' @inheritParams convert_colour
#' @param colour A numeric matrix (or an object coercible to one) with colours
#' encoded in the rows and the different colour space values in the columns. For
#' all colourspaces except `'cmyk'` this will mean a matrix with three columns -
#' for `'cmyk'` it means four columns. Alternatively, `colour` may be a list of
#' length three (or four for `'cmyk'`) numeric vectors of the same length.
#' @param alpha A numeric vector between 0 and 1. Will be recycled to the number
#' of rows in `colour`. If `NULL` or a single `NA` it will be ignored.
#' @param from The input colour space. Allowed values are: `"cmy"`,
Expand All @@ -17,6 +21,10 @@
#' @param white The white reference of the input colour space. Will only have an
#' effect for relative colour spaces such as Lab and luv. Any value accepted by
#' [as_white_ref()] allowed.
#' @param na_value A valid colour string or `NA` to use when `colour` contains
#' `NA` elements or is invalid in the RGB space. The general approach in farver
#' is to carry `NA` values over, but if you want to mimick [col2rgb()] you should
#' set `na_value = 'transparent'`, i.e. treat `NA` as transparent white.
#'
#' @return A character vector with colours encoded as `#RRGGBB(AA)`
#'
Expand All @@ -39,26 +47,55 @@
#' spectrum_hcl <- convert_colour(spectrum, 'rgb', 'hcl')
#' encode_colour(spectrum_hcl, from = 'hcl')
#'
encode_colour <- function(colour, alpha = NULL, from = 'rgb', white = 'D65') {
encode_colour <- function(colour, alpha = NULL, from = 'rgb', white = 'D65', na_value = NA_character_) {
if (from != 'rgb') {
white <- as_white_ref(white)
}
encode_c(colour, alpha, colourspace_match(from), white)
encode_c(colour, alpha, colourspace_match(from), white, out_format = 1L, na_value)
}

encode_c <- function(colour, alpha, from, white) {
if (nrow(colour) == 0) {
encode_c <- function(colour, alpha, from, white, out_format = 1L, na_value) {
# colour has zero colours:
if ((is.matrix(colour) || is.data.frame(colour)) && nrow(colour) == 0) {
return(character())
}
# Colour has zero colours (given as a list of channels)
if (is.list(colour) && (length(colour) == 0 || length(colour[[1]]) == 0)) {
return(character())
}
# Colour is neither a list or a matrix, so let's coerce it
if (!is.matrix(colour) && !is.list(colour)) {
colour <- as.matrix(colour)
}
# How many colours do we have?
if (is.matrix(colour)) {
num_colours <- nrow(colour)
} else {
num_colours <- length(colour[[1]])
}

if (!is.null(alpha)) {
alpha <- alpha * 255
if (length(alpha) == 0) {
alpha <- NULL
} else if (length(alpha) != 1) {
alpha <- rep_len(alpha, nrow(colour))
alpha <- rep_len(alpha, num_colours)
} else if (is.na(alpha) || alpha == 1) {
alpha <- NULL
}
}
.Call(`farver_encode_c`, as.matrix(colour), alpha, as.integer(from), white)
out_format <- as.integer(out_format)
if (out_format != 1L && out_format != 2L) {
stop("out_format must be 1L (for character) or 2L (for native)")
}
if (length(na_value) == 0) {
na_value <- NA_character_
}
if (length(na_value) > 1) {
stop("na_value must be a string")
}
na_value <- as.character(na_value)

.Call(`farver_encode_c`, colour, alpha, as.integer(from), white, out_format, na_value)
}

30 changes: 20 additions & 10 deletions R/native.R
Original file line number Diff line number Diff line change
Expand Up @@ -12,10 +12,9 @@
#'
#' @param colour For `encode_native` either a vector of hex-encoded
#' colours/colour names or a matrix encoding colours in any of the supported
#' colour spaces. If the latter, the colours will be encoded to a hex string
#' using [encode_colour()] first. For `decode_native` it is a vector of
#' colour spaces. For `decode_native` it is a vector of
#' integers.
#' @param ... Arguments passed on to [encode_colour()]
#' @inheritParams encode_colour
#'
#' @return `encode_native()` returns an integer vector and `decode_native()`
#' returns a character vector, both matching the length of the input.
Expand All @@ -33,21 +32,32 @@
#' # Convert back
#' decode_native(native_col)
#'
encode_native <- function(colour, ...) {
if (!is.character(colour)) {
colour <- encode_colour(colour, ...)
encode_native <- function(colour, alpha = NULL, from = 'rgb', white = 'D65', na_value = NA) {
if (is.character(colour)) {
return(encode_native_c(colour, na_value = na_value))
}
encode_native_c(colour)
if (from != 'rgb') {
white <- as_white_ref(white)
}
encode_c(colour, alpha, colourspace_match(from), white, out_format = 2L, na_value = na_value)
}

#' @rdname native_encoding
#' @export
decode_native <- function(colour) {
decode_native_c(colour)
}

encode_native_c <- function(colour) {
.Call(`farver_encode_native_c`, colour)
encode_native_c <- function(colour, na_value = NA_character_) {
if (length(na_value) == 0) {
na_value <- NA_character_
}
if (length(na_value) > 1) {
stop("na_value must be a string")
}
na_value <- as.character(na_value)
.Call(`farver_encode_native_c`, colour, na_value)
}
decode_native_c <- function(colour) {
.Call(`farver_decode_native_c`, as.integer(colour))
}
}
16 changes: 14 additions & 2 deletions man/encode_colour.Rd

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

23 changes: 19 additions & 4 deletions man/native_encoding.Rd

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

Loading