encode_colour accepts a list besides a matrix

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,9 @@
 # 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).
+
 # 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"`, 
@@ -47,18 +51,34 @@ encode_colour <- function(colour, alpha = NULL, from = 'rgb', white = 'D65') {
 }
 
 encode_c <- function(colour, alpha, from, white) {
-  if (nrow(colour) == 0) {
+  # 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)
+  .Call(`farver_encode_c`, colour, alpha, as.integer(from), white)
 }

src/encode.cpp

@@ -49,16 +49,107 @@ inline std::string prepare_code(const char* col) {
   return code;
 }
 
+struct colour_channels {
+  int n;
+  int *colour_i1;
+  int *colour_i2;
+  int *colour_i3;
+  int *colour_i4;
+  double *colour_d1;
+  double *colour_d2;
+  double *colour_d3;
+  double *colour_d4;
+  bool colour_is_int;
+};
+
+static void get_input_channels(struct colour_channels *cc, SEXP colour, int n_channels) {
+  if (TYPEOF(colour) == VECSXP) {
+    int input_n_channels = Rf_length(colour);
+    if (input_n_channels < n_channels) {
+      Rf_errorcall(R_NilValue, "Colour, if given as a list, must contain at least %i elements (channels)", n_channels);
+    }
+    input_n_channels = n_channels;
+    SEXP a_channel = VECTOR_ELT(colour, 0);
+    cc->colour_is_int = Rf_isInteger(a_channel);
+    if (!(cc->colour_is_int)) {
+      if (TYPEOF(a_channel) != REALSXP) {
+        Rf_error("All channels must be either integers or reals");
+      }
+      cc->colour_d1 = REAL(a_channel);
+    } else {
+      cc->colour_i1 = INTEGER(a_channel);
+    }
+    cc->n = Rf_length(a_channel);
+    for (int i=1; i<n_channels;i++) {
+      a_channel = VECTOR_ELT(colour, i);
+      if (cc->colour_is_int) {
+        if (TYPEOF(a_channel) != INTSXP) {
+          Rf_error("The first channel was integer, channel %d is not. All channels should be of the same type", i+1);
+        }
+      } else {
+        if (TYPEOF(a_channel) != REALSXP) {
+          Rf_error("The first channel was real, channel %d is not. All channels should be of the same type", i+1);
+        }
+      }
+      int n_thisch = Rf_length(a_channel);
+      if (n_thisch != cc->n) {
+        Rf_error("The first channel was of length %d. Channel %d is of length %d. All channels should be of the same length", cc->n, i+1, n_thisch);
+      }
+      switch(i) {
+      case 1:
+        if (cc->colour_is_int) {
+          cc->colour_i2 = INTEGER(a_channel);
+        } else {
+          cc->colour_d2 = REAL(a_channel);
+        }
+        break;
+      case 2:
+        if (cc->colour_is_int) {
+          cc->colour_i3 = INTEGER(a_channel);
+        } else {
+          cc->colour_d3 = REAL(a_channel);
+        }
+        break;
+      case 3:
+        if (cc->colour_is_int) {
+          cc->colour_i4 = INTEGER(a_channel);
+        } else {
+          cc->colour_d4 = REAL(a_channel);
+        }
+        break;
+      }
+    }
+  } else if (Rf_isMatrix(colour)) {
+    cc->colour_is_int = Rf_isInteger(colour);
+    if (Rf_ncols(colour) < n_channels) {
+      Rf_errorcall(R_NilValue, "Colour in this format must contain at least %i columns", n_channels);
+    }
+    cc->n = Rf_nrows(colour);
+    if (cc->colour_is_int) {
+      cc->colour_i1 = INTEGER(colour);
+      cc->colour_i2 = cc->colour_i1 + cc->n;
+      cc->colour_i3 = cc->colour_i1 + 2*cc->n;
+      cc->colour_i4 = cc->colour_i1 + 3*cc->n;
+    } else {
+      cc->colour_d1 = REAL(colour);
+      cc->colour_d2 = cc->colour_d1 + cc->n;
+      cc->colour_d3 = cc->colour_d1 + 2*cc->n;
+      cc->colour_d4 = cc->colour_d1 + 3*cc->n;
+    }
+  } else {
+    Rf_error("invalid input format, expected a matrix or a list of vectors");
+  }
+  return;
+}
+
 template <typename From>
 SEXP encode_impl(SEXP colour, SEXP alpha, SEXP white) {
-  int n_channels = dimension<From>();
-  if (Rf_ncols(colour) < n_channels) {
-    Rf_errorcall(R_NilValue, "Colour in this format must contain at least %i columns", n_channels);
-  }
   static ColorSpace::Rgb rgb;
+  struct colour_channels cc;
+  int n_channels = dimension<From>();
+  get_input_channels(&cc, colour, n_channels);
   ColorSpace::XyzConverter::SetWhiteReference(REAL(white)[0], REAL(white)[1], REAL(white)[2]);
-  int n = Rf_nrows(colour);
-  SEXP codes = PROTECT(Rf_allocVector(STRSXP, n));
+  SEXP codes = PROTECT(Rf_allocVector(STRSXP, cc.n));
   bool has_alpha = !Rf_isNull(alpha);
   char alpha1 = '\0';
   char alpha2 = '\0';
@@ -90,25 +181,13 @@ SEXP encode_impl(SEXP colour, SEXP alpha, SEXP white) {
   } else {
     buf = buffer;
   }
-  int offset1 = 0;
-  int offset2 = offset1 + n;
-  int offset3 = offset2 + n;
-  int offset4 = offset3 + n;
 
-  int* colour_i = NULL;
-  double* colour_d = NULL;
-  bool colour_is_int = Rf_isInteger(colour);
   int num;
-  if (colour_is_int) {
-    colour_i = INTEGER(colour);
-  } else {
-    colour_d = REAL(colour);
-  }
-  for (int i = 0; i < n; ++i) {
-    if (colour_is_int) {
-      fill_rgb<From>(&rgb, colour_i[offset1 + i], colour_i[offset2 + i], colour_i[offset3 + i], n_channels == 4 ? colour_i[offset4 + i] : 0);
+  for (int i = 0; i < cc.n; ++i) {
+    if (cc.colour_is_int) {
+      fill_rgb<From>(&rgb, cc.colour_i1[i], cc.colour_i2[i], cc.colour_i3[i], n_channels == 4 ? cc.colour_i4[i]: 0);
     } else {
-      fill_rgb<From>(&rgb, colour_d[offset1 + i], colour_d[offset2 + i], colour_d[offset3 + i], n_channels == 4 ? colour_d[offset4 + i] : 0.0);
+      fill_rgb<From>(&rgb, cc.colour_d1[i], cc.colour_d2[i], cc.colour_d3[i], n_channels == 4 ? cc.colour_d4[i] : 0.0);
     }
     if (!rgb.valid) {
       SET_STRING_ELT(codes, i, R_NaString);
@@ -152,19 +231,26 @@ SEXP encode_impl(SEXP colour, SEXP alpha, SEXP white) {
 
     SET_STRING_ELT(codes, i, Rf_mkChar(buf));
   }
-
-  copy_names(colour, codes);
+
+  if (Rf_isMatrix(colour)) {
+    copy_names(colour, codes);
+  } else if (Rf_inherits(colour, "data.frame")) {
+    SEXP names = PROTECT(Rf_getAttrib(colour, Rf_install("dimnames")));
+    if (!Rf_isNull(names)) {
+      names = VECTOR_ELT(names, 0);
+    }
+    Rf_namesgets(codes, names);
+    UNPROTECT(1);
+  }
   UNPROTECT(1);
   return codes;
 }
 
 template<>
 SEXP encode_impl<ColorSpace::Rgb>(SEXP colour, SEXP alpha, SEXP white) {
-  if (Rf_ncols(colour) < 3) {
-    Rf_errorcall(R_NilValue, "Colour in RGB format must contain at least 3 columns");
-  }
-  int n = Rf_nrows(colour);
-  SEXP codes = PROTECT(Rf_allocVector(STRSXP, n));
+  struct colour_channels cc;
+  get_input_channels(&cc, colour, 3);
+  SEXP codes = PROTECT(Rf_allocVector(STRSXP, cc.n));
   bool has_alpha = !Rf_isNull(alpha);
   char alpha1 = '\0';
   char alpha2 = '\0';
@@ -196,21 +282,14 @@ SEXP encode_impl<ColorSpace::Rgb>(SEXP colour, SEXP alpha, SEXP white) {
   } else {
     buf = buffer;
   }
-  int offset1 = 0;
-  int offset2 = offset1 + n;
-  int offset3 = offset2 + n;
 
-  int* colour_i = NULL;
-  double* colour_d = NULL;
-  bool colour_is_int = Rf_isInteger(colour);
   int num;
-  if (colour_is_int) {
+  if (cc.colour_is_int) {
     int r, g, b;
-    colour_i = INTEGER(colour);
-    for (int i = 0; i < n; ++i) {
-      r = colour_i[offset1 + i];
-      g = colour_i[offset2 + i];
-      b = colour_i[offset3 + i];
+    for (int i = 0; i < cc.n; ++i) {
+      r = cc.colour_i1[i];
+      g = cc.colour_i2[i];
+      b = cc.colour_i3[i];
       if (r == R_NaInt || g == R_NaInt || b == R_NaInt) {
         SET_STRING_ELT(codes, i, R_NaString);
         continue;
@@ -251,11 +330,10 @@ SEXP encode_impl<ColorSpace::Rgb>(SEXP colour, SEXP alpha, SEXP white) {
     }
   } else {
     double r, g, b;
-    colour_d = REAL(colour);
-    for (int i = 0; i < n; ++i) {
-      r = colour_d[offset1 + i];
-      g = colour_d[offset2 + i];
-      b = colour_d[offset3 + i];
+    for (int i = 0; i < cc.n; ++i) {
+      r = cc.colour_d1[i];
+      g = cc.colour_d2[i];
+      b = cc.colour_d3[i];
       if (!(R_finite(r) && R_finite(g) && R_finite(b))) {
         SET_STRING_ELT(codes, i, R_NaString);
         continue;
@@ -296,7 +374,9 @@ SEXP encode_impl<ColorSpace::Rgb>(SEXP colour, SEXP alpha, SEXP white) {
     }
   }
 
-  copy_names(colour, codes);
+  if (Rf_isMatrix(colour)) {
+    copy_names(colour, codes);
+  }
   UNPROTECT(1);
   return codes;
 }

tests/testthat/test-comparison.R

@@ -1,5 +1,3 @@
-context("comparison")
-
 spectrum <- unname(t(col2rgb(rainbow(10))))
 spectrum2 <- unname(t(col2rgb(heat.colors(5))))
 reconvert <- function(data, space) {

tests/testthat/test-conversion.R

@@ -1,5 +1,3 @@
-context("conversion")
-
 spectrum <- unname(t(col2rgb(rainbow(10))))
 reconvert <- function(data, space) {
   unname(round(convert_colour(convert_colour(data, 'rgb', space), space, 'rgb')))

tests/testthat/test-encoding.R

@@ -21,4 +21,13 @@ test_that("colours can be encoded", {
 test_that("alpha gets encoded correctly", {
   alpha_col <- encode_colour(cols_dec[1:6,], alpha = seq(0, 1, length.out = 6))
   expect_equal(substr(alpha_col, 8, 9), c("00", "33", "66", "99", "CC", ""))
-})
+})
+
+test_that("colours can be encoded from a list of channels", {
+  cols_cmy <- convert_colour(cols_dec, 'rgb', 'cmy')
+  expect_equal(encode_colour(list(cols_dec[,1], cols_dec[,2], cols_dec[,3])), cols)
+  expect_equal(encode_colour(data.frame(cols_dec[,1], cols_dec[,2], cols_dec[,3])), cols)
+  expect_equal(encode_colour(list(cols_cmy[,1], cols_cmy[,2], cols_cmy[,3]), from = 'cmy'), cols)
+  expect_equal(encode_colour(data.frame(cols_cmy[,1], cols_cmy[,2], cols_cmy[,3]), from = 'cmy'), cols)
+})
+