ensure alpha can be applied recursively in toRGB

Author: cpsievert

R/test-toRGB.R

@@ -0,0 +1,6 @@
+context("toRGB")
+
+test_that("Can apply alpha recursively with toRGB()", {
+  col <- toRGB(toRGB("black", 0.9), 0.9)
+  expect_match(col, "rgba\\(0,0,0,0\\.80")
+})

R/toRGB.R

@@ -4,28 +4,35 @@
 #' @return hexadecimal colour value (if is.na(x), return "transparent" for compatibility with Plotly)
 #' @export
 toRGB <- function(x, alpha = 1) {
+  if (is.null(x)) return(x)
   # add alpha to already converted "rgb(x,y,z)" codes
-  idx <- grepl("^rgb\\(", x) & alpha < 1 & 0 < alpha
+  idx <- grepl("^rgba\\(", x) & alpha <= 1 & 0 <= alpha
   if (any(idx)) {
-    x[idx] <- sub("^rgb", "rgba", x[idx])
-    x[idx] <- paste0(sub("\\)", ",", x[idx]), alpha, ")")
+    x[idx] <- rgb2hex(x[idx])
   }
-  # return code if 
-  if (any(is.null(x) || grepl("^rgb[a]?\\(", x))) return(x)
   # for some reason ggplot2 has "NA" in some place (instead of NA)
   if (is.character(x)) {
     x[x == "NA"] <- NA
   }
   # as of ggplot2 version 1.1, an NA alpha is treated as though it's 1
   alpha[is.na(alpha)] <- 1
-  rgb_matrix <- col2rgb(x, alpha = TRUE)
+  rgb_matrix <- grDevices::col2rgb(x, alpha = TRUE)
   # multiply the existing alpha with specified alpha (both on 0-1 scale)
   rgb_matrix["alpha", ] <- alpha * scales::rescale(
     rgb_matrix["alpha", ], from = c(0, 255)
   )
-  container <- ifelse(rgb_matrix["alpha", ] == 1, "rgb(%s)", "rgba(%s)")
-  rgba <- sprintf(container, apply(rgb_matrix, 2, paste, collapse = ","))
-  rgba <- sub(",1\\)", ")", rgba)
+  rgba <- sprintf("rgba(%s)", apply(rgb_matrix, 2, paste, collapse = ","))
   rgba[is.na(x)] <- "transparent"
   rgba
 }
+
+# take a 'plotly color' and produce a hex code
+rgb2hex <- function(string = "rgba(255,255,255,1)") {
+  vals <- sub("rgba\\(", "", sub("\\)", "", string))
+  valz <- strsplit(vals, ",")
+  sapply(valz, function(x) {
+    x <- setNames(as.numeric(x), c("red", "green", "blue", "alpha"))
+    x[["alpha"]] <- x[["alpha"]] * 255
+    do.call(grDevices::rgb, c(x, list(maxColorValue = 255)))
+  })
+}

tests/testthat/test-ggplot-rect.R

@@ -145,3 +145,14 @@ test_that('rect aes(fill) with constant color', {
   expect_false(traces.by.name[[1]]$fillcolor ==
                traces.by.name[[2]]$fillcolor)
 })
+
+
+p <- ggplot(data = data.frame(x1 = 1, x2 = 2, y1 = 1, y2 = 2)) + 
+  geom_rect(aes(xmin = x1, xmax = x2, ymin = y1, ymax = y2), 
+            fill = "#00000011", color = "black")
+
+test_that('Specifying alpha in hex color code works', {
+  info <- expect_traces(p, 1, "fill-hex-alpha")
+  expect_match(l$data[[1]]$fillcolor, "rgba\\(0,0,0,0\\.0[6]+")
+})
+