@@ -130,15 +130,6 @@ colorway <- function(p = NULL) {
130
130
# TODO: make this more unique?
131
131
crosstalk_key <- function () " .crossTalkKey"
132
132
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
-
142
133
# arrange data if the vars exist, don't throw error if they don't
143
134
arrange_safe <- function (data , vars ) {
144
135
vars <- vars [vars %in% names(data )]
@@ -658,6 +649,51 @@ verify_mode <- function(p) {
658
649
p
659
650
}
660
651
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
+
661
697
# if an object (e.g. trace.marker) contains a non-default attribute, it has been user-specified
662
698
user_specified <- function (obj = NULL ) {
663
699
if (! length(obj )) return (FALSE )
0 commit comments