diff --git a/R/plotly_build.R b/R/plotly_build.R
index d00df27d9a..daac2d78b5 100644
--- a/R/plotly_build.R
+++ b/R/plotly_build.R
@@ -373,6 +373,9 @@ plotly_build.plotly <- function(p, registerFrames = TRUE) {
p <- verify_guides(p)
+ # verify colorscale attributes are in a sensible data structure
+ p <- verify_colorscale(p)
+
# verify plot attributes are legal according to the plotly.js spec
p <- verify_attr_names(p)
# box up 'data_array' attributes where appropriate
@@ -804,11 +807,6 @@ map_color <- function(traces, stroke = FALSE, title = "", colorway, na.color = "
colorObj[c("cmin", "cmax")] <- NULL
colorObj[["showscale"]] <- default(TRUE)
traces[[i]] <- modify_list(colorObj, traces[[i]])
- traces[[i]]$colorscale <- as_df(traces[[i]]$colorscale)
- # sigh, contour colorscale doesn't support alpha
- if (grepl("contour", traces[[i]][["type"]])) {
- traces[[i]]$colorscale[, 2] <- strip_alpha(traces[[i]]$colorscale[, 2])
- }
traces[[i]] <- structure(traces[[i]], class = c("plotly_colorbar", "zcolor"))
next
}
@@ -852,8 +850,6 @@ map_color <- function(traces, stroke = FALSE, title = "", colorway, na.color = "
traces[[i]] <- modify_list(list(fillcolor = col), traces[[i]])
}
- # make sure the colorscale is going to convert to JSON nicely
- traces[[i]]$marker$colorscale <- as_df(traces[[i]]$marker$colorscale)
}
}
diff --git a/R/utils.R b/R/utils.R
index 6b573eb95b..8c1496185b 100644
--- a/R/utils.R
+++ b/R/utils.R
@@ -130,15 +130,6 @@ colorway <- function(p = NULL) {
# TODO: make this more unique?
crosstalk_key <- function() ".crossTalkKey"
-# modifyList turns elements that are data.frames into lists
-# which changes the behavior of toJSON
-as_df <- function(x) {
- if (is.null(x) || is.matrix(x)) return(x)
- if (is.list(x) && !is.data.frame(x)) {
- setNames(as.data.frame(x), NULL)
- }
-}
-
# arrange data if the vars exist, don't throw error if they don't
arrange_safe <- function(data, vars) {
vars <- vars[vars %in% names(data)]
@@ -658,6 +649,51 @@ verify_mode <- function(p) {
p
}
+
+verify_colorscale <- function(p) {
+ p$x$data <- lapply(p$x$data, function(trace) {
+ trace$colorscale <- colorscale_json(trace$colorscale)
+ trace$marker$colorscale <- colorscale_json(trace$marker$colorscale)
+ trace
+ })
+ p
+}
+
+# Coerce `x` into a data structure that can map to a colorscale attribute.
+# Note that colorscales can either be the name of a scale (e.g., 'Rainbow') or
+# a 2D array (e.g., [[0, 'rgb(0,0,255)'], [1, 'rgb(255,0,0)']])
+colorscale_json <- function(x) {
+ if (!length(x)) return(x)
+ if (is.character(x)) return(x)
+ if (is.matrix(x)) {
+ if (ncol(x) != 2) stop("A colorscale matrix requires two columns")
+ x <- as.data.frame(x)
+ x[, 1] <- as.numeric(x[, 1])
+ }
+ # ensure a list like this: list(list(0, 0.5, 1), list("red", "white", "blue"))
+ # converts to the correct dimensions: [[0, 'red'], [0.5, 'white'], [1, 'blue']]
+ if (is.list(x) && length(x) == 2) {
+ n1 <- length(x[[1]])
+ n2 <- length(x[[2]])
+ if (n1 != n2 || n1 == 0 || n2 == 0) {
+ warning("A colorscale list must of elements of the same (non-zero) length")
+ } else if (!is.data.frame(x) && can_be_numeric(x[[1]])) {
+ x <- data.frame(
+ val = as.numeric(x[[1]]),
+ col = as.character(x[[2]]),
+ stringsAsFactors = FALSE
+ )
+ x <- setNames(x, NULL)
+ }
+ }
+ x
+}
+
+can_be_numeric <- function(x) {
+ xnum <- suppressWarnings(as.numeric(x))
+ sum(is.na(x)) == sum(is.na(xnum))
+}
+
# if an object (e.g. trace.marker) contains a non-default attribute, it has been user-specified
user_specified <- function(obj = NULL) {
if (!length(obj)) return(FALSE)
diff --git a/tests/figs/colorscales/colorramp.svg b/tests/figs/colorscales/colorramp.svg
new file mode 100644
index 0000000000..339a37794b
--- /dev/null
+++ b/tests/figs/colorscales/colorramp.svg
@@ -0,0 +1 @@
+
diff --git a/tests/figs/colorscales/contour-alpha.svg b/tests/figs/colorscales/contour-alpha.svg
new file mode 100644
index 0000000000..9845f0dbcb
--- /dev/null
+++ b/tests/figs/colorscales/contour-alpha.svg
@@ -0,0 +1 @@
+
diff --git a/tests/figs/colorscales/contour-colorscale.svg b/tests/figs/colorscales/contour-colorscale.svg
new file mode 100644
index 0000000000..8abb4e1f11
--- /dev/null
+++ b/tests/figs/colorscales/contour-colorscale.svg
@@ -0,0 +1 @@
+
diff --git a/tests/figs/colorscales/marker-colorscale.svg b/tests/figs/colorscales/marker-colorscale.svg
new file mode 100644
index 0000000000..27e91b837c
--- /dev/null
+++ b/tests/figs/colorscales/marker-colorscale.svg
@@ -0,0 +1 @@
+
diff --git a/tests/figs/colorscales/test-df.svg b/tests/figs/colorscales/test-df.svg
new file mode 100644
index 0000000000..e66b88ad0c
--- /dev/null
+++ b/tests/figs/colorscales/test-df.svg
@@ -0,0 +1 @@
+
diff --git a/tests/figs/colorscales/test-list-2.svg b/tests/figs/colorscales/test-list-2.svg
new file mode 100644
index 0000000000..95b381bef2
--- /dev/null
+++ b/tests/figs/colorscales/test-list-2.svg
@@ -0,0 +1 @@
+
diff --git a/tests/figs/colorscales/test-list-3.svg b/tests/figs/colorscales/test-list-3.svg
new file mode 100644
index 0000000000..95b381bef2
--- /dev/null
+++ b/tests/figs/colorscales/test-list-3.svg
@@ -0,0 +1 @@
+
diff --git a/tests/figs/colorscales/test-list.svg b/tests/figs/colorscales/test-list.svg
new file mode 100644
index 0000000000..e66b88ad0c
--- /dev/null
+++ b/tests/figs/colorscales/test-list.svg
@@ -0,0 +1 @@
+
diff --git a/tests/figs/colorscales/test-matrix.svg b/tests/figs/colorscales/test-matrix.svg
new file mode 100644
index 0000000000..e66b88ad0c
--- /dev/null
+++ b/tests/figs/colorscales/test-matrix.svg
@@ -0,0 +1 @@
+
diff --git a/tests/testthat/test-plotly-colorscale.R b/tests/testthat/test-plotly-colorscale.R
new file mode 100644
index 0000000000..9f328a9752
--- /dev/null
+++ b/tests/testthat/test-plotly-colorscale.R
@@ -0,0 +1,72 @@
+context("colorscales")
+
+
+test_that("Can specify marker.colorscale", {
+ p <- plot_ly(
+ x = c(-9, -6, -5, -3, -1),
+ y = c(0, 1, 4, 5, 7),
+ marker = list(
+ color = 1:5,
+ colorscale='Rainbow',
+ showscale = TRUE
+ )
+ )
+ l <- expect_doppelganger_built(p, "marker.colorscale")
+})
+
+test_that("Can specify contour colorscale", {
+ p <- plot_ly(
+ x = c(-9, -6, -5, -3, -1),
+ y = c(0, 1, 4, 5, 7),
+ z = matrix(c(10, 10.625, 12.5, 15.625, 20, 5.625, 6.25, 8.125, 11.25, 15.625, 2.5, 3.125, 5, 8.125, 12.5, 0.625, 1.25, 3.125,
+ 6.25, 10.625, 0, 0.625, 2.5, 5.625, 10), nrow = 5, ncol = 5),
+ type = "contour",
+ colorscale = 'Rainbow'
+ )
+ l <- expect_doppelganger_built(p, "contour-colorscale")
+})
+
+test_that("Can provide a color interpolation function", {
+ p <- plot_ly(x = 1:10, y = 1:10, color = 1:10, colors = scales::colour_ramp(c("red", "green")))
+ l <- expect_doppelganger_built(p, "colorRamp")
+})
+
+test_that("Can specify contour colorscale", {
+
+ plot_colorscale <- function(colorscale) {
+ plot_ly(
+ x = 1:10,
+ y = 1:10,
+ marker = list(
+ color = c(1:9, NA),
+ colorscale = colorscale,
+ showscale = TRUE
+ )
+ )
+ }
+
+ pal <- scales::colour_ramp(c("red", "green"))
+ colorScale <- list(
+ val = seq(0, 1, by = 0.1),
+ col = pal(seq(0, 1, by = 0.1))
+ )
+ test_list <- plot_colorscale(colorScale)
+ test_df <- plot_colorscale(as.data.frame(colorScale))
+ test_matrix <- plot_colorscale(as.matrix(as.data.frame(colorScale)))
+
+ expect_doppelganger_built(test_list, "test_list")
+ expect_doppelganger_built(test_df, "test_df")
+ expect_doppelganger_built(test_matrix, "test_matrix")
+
+ test_list_2 <- plot_colorscale(list(list(0, "rgb(0,0,255)"), list(1, "rgb(0,255,0)")))
+ test_list_3 <- plot_colorscale(list(list(0, 1), list("rgb(0,0,255)", "rgb(0,255,0)")))
+
+ expect_doppelganger_built(test_list_2, "test_list_2")
+ expect_doppelganger_built(test_list_3, "test_list_3")
+})
+
+
+test_that("contour colorscale supports alpha", {
+ p <- plot_ly(z = volcano, type = "contour", stroke = I("black"), alpha = 0.1)
+ l <- expect_doppelganger_built(p, "contour-alpha")
+})