Skip to content

Commit 02c9aa4

Browse files
authored
Merge pull request #1485 from ropensci/colorscale-fix
better handling of colorscale inputs
2 parents d06a053 + 0941f05 commit 02c9aa4

12 files changed

+129
-16
lines changed

R/plotly_build.R

Lines changed: 3 additions & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -373,6 +373,9 @@ plotly_build.plotly <- function(p, registerFrames = TRUE) {
373373

374374
p <- verify_guides(p)
375375

376+
# verify colorscale attributes are in a sensible data structure
377+
p <- verify_colorscale(p)
378+
376379
# verify plot attributes are legal according to the plotly.js spec
377380
p <- verify_attr_names(p)
378381
# box up 'data_array' attributes where appropriate
@@ -804,11 +807,6 @@ map_color <- function(traces, stroke = FALSE, title = "", colorway, na.color = "
804807
colorObj[c("cmin", "cmax")] <- NULL
805808
colorObj[["showscale"]] <- default(TRUE)
806809
traces[[i]] <- modify_list(colorObj, traces[[i]])
807-
traces[[i]]$colorscale <- as_df(traces[[i]]$colorscale)
808-
# sigh, contour colorscale doesn't support alpha
809-
if (grepl("contour", traces[[i]][["type"]])) {
810-
traces[[i]]$colorscale[, 2] <- strip_alpha(traces[[i]]$colorscale[, 2])
811-
}
812810
traces[[i]] <- structure(traces[[i]], class = c("plotly_colorbar", "zcolor"))
813811
next
814812
}
@@ -852,8 +850,6 @@ map_color <- function(traces, stroke = FALSE, title = "", colorway, na.color = "
852850
traces[[i]] <- modify_list(list(fillcolor = col), traces[[i]])
853851
}
854852

855-
# make sure the colorscale is going to convert to JSON nicely
856-
traces[[i]]$marker$colorscale <- as_df(traces[[i]]$marker$colorscale)
857853
}
858854
}
859855

R/utils.R

Lines changed: 45 additions & 9 deletions
Original file line numberDiff line numberDiff line change
@@ -130,15 +130,6 @@ colorway <- function(p = NULL) {
130130
# TODO: make this more unique?
131131
crosstalk_key <- function() ".crossTalkKey"
132132

133-
# modifyList turns elements that are data.frames into lists
134-
# which changes the behavior of toJSON
135-
as_df <- function(x) {
136-
if (is.null(x) || is.matrix(x)) return(x)
137-
if (is.list(x) && !is.data.frame(x)) {
138-
setNames(as.data.frame(x), NULL)
139-
}
140-
}
141-
142133
# arrange data if the vars exist, don't throw error if they don't
143134
arrange_safe <- function(data, vars) {
144135
vars <- vars[vars %in% names(data)]
@@ -658,6 +649,51 @@ verify_mode <- function(p) {
658649
p
659650
}
660651

652+
653+
verify_colorscale <- function(p) {
654+
p$x$data <- lapply(p$x$data, function(trace) {
655+
trace$colorscale <- colorscale_json(trace$colorscale)
656+
trace$marker$colorscale <- colorscale_json(trace$marker$colorscale)
657+
trace
658+
})
659+
p
660+
}
661+
662+
# Coerce `x` into a data structure that can map to a colorscale attribute.
663+
# Note that colorscales can either be the name of a scale (e.g., 'Rainbow') or
664+
# a 2D array (e.g., [[0, 'rgb(0,0,255)'], [1, 'rgb(255,0,0)']])
665+
colorscale_json <- function(x) {
666+
if (!length(x)) return(x)
667+
if (is.character(x)) return(x)
668+
if (is.matrix(x)) {
669+
if (ncol(x) != 2) stop("A colorscale matrix requires two columns")
670+
x <- as.data.frame(x)
671+
x[, 1] <- as.numeric(x[, 1])
672+
}
673+
# ensure a list like this: list(list(0, 0.5, 1), list("red", "white", "blue"))
674+
# converts to the correct dimensions: [[0, 'red'], [0.5, 'white'], [1, 'blue']]
675+
if (is.list(x) && length(x) == 2) {
676+
n1 <- length(x[[1]])
677+
n2 <- length(x[[2]])
678+
if (n1 != n2 || n1 == 0 || n2 == 0) {
679+
warning("A colorscale list must of elements of the same (non-zero) length")
680+
} else if (!is.data.frame(x) && can_be_numeric(x[[1]])) {
681+
x <- data.frame(
682+
val = as.numeric(x[[1]]),
683+
col = as.character(x[[2]]),
684+
stringsAsFactors = FALSE
685+
)
686+
x <- setNames(x, NULL)
687+
}
688+
}
689+
x
690+
}
691+
692+
can_be_numeric <- function(x) {
693+
xnum <- suppressWarnings(as.numeric(x))
694+
sum(is.na(x)) == sum(is.na(xnum))
695+
}
696+
661697
# if an object (e.g. trace.marker) contains a non-default attribute, it has been user-specified
662698
user_specified <- function(obj = NULL) {
663699
if (!length(obj)) return(FALSE)

tests/figs/colorscales/colorramp.svg

Lines changed: 1 addition & 0 deletions
Loading

tests/figs/colorscales/contour-alpha.svg

Lines changed: 1 addition & 0 deletions
Loading

tests/figs/colorscales/contour-colorscale.svg

Lines changed: 1 addition & 0 deletions
Loading

0 commit comments

Comments
 (0)