Performance: encode_native() does not need an intermediate character vector

DESCRIPTION

@@ -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

NEWS.md

@@ -1,5 +1,12 @@
 # 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 (#375, @zeehio).
+
 # farver 2.1.1
 
 * Added input checking to a range of functions to guard against segfaults with 

R/encode.R

@@ -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"`, 
@@ -43,22 +47,42 @@ encode_colour <- function(colour, alpha = NULL, from = 'rgb', white = 'D65') {
   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)
 }
 
-encode_c <- function(colour, alpha, from, white) {
-  if (nrow(colour) == 0) {
+encode_c <- function(colour, alpha, from, white, out_format = 1L) {
+  # 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)")
+  }
+  .Call(`farver_encode_c`, colour, alpha, as.integer(from), white, out_format)
 }

R/native.R

@@ -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.
@@ -33,12 +32,16 @@
 #' # 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') {
+  if (is.character(colour)) {
+    return(encode_native_c(colour))
   }
-  encode_native_c(colour)
+  if (from != 'rgb') {
+    white <- as_white_ref(white)
+  }
+  encode_c(colour, alpha, colourspace_match(from), white, out_format = 2L)
 }
+
 #' @rdname native_encoding
 #' @export
 decode_native <- function(colour) {
@@ -50,4 +53,4 @@ encode_native_c <- function(colour) {
 }
 decode_native_c <- function(colour) {
   .Call(`farver_decode_native_c`, as.integer(colour))
-}
+}