Merge branch 'master' into data.table

Author: Matt Summersgill

.gitignore

@@ -4,6 +4,7 @@ Rapp.history
 *.RData
 *.Rproj.user
 *.DS_Store
+node_modules/
 build_site.R
 todo.R
 inst/examples/*.html

R/ggplotly.R

@@ -632,7 +632,7 @@ gg2list <- function(p, width = NULL, height = NULL,
           # convert the special *degree expression in plotmath to HTML entity
           # TODO: can this be done more generally for all ?
           rng[[paste0(xy, ".labels")]] <- sub(
-            "\\*\\s+degree\\s+\\*", "&#176;", rng[[paste0(xy, ".labels")]]
+            "\\*\\s+degree[ ]?[\\*]?", "&#176;", rng[[paste0(xy, ".labels")]]
           )
         }
 

R/plotly_build.R

@@ -450,10 +450,12 @@ registerFrames <- function(p, frameMapping = NULL) {
       invisible <- modify_list(p$x$data[[idx]], list(visible = FALSE))
       d <- c(d, list(invisible))
     }
-    
     p$x$frames[[i]] <- list(
       name = as.character(format(nm)),
-      data = d
+      data = lapply(d, function(tr) { 
+        spec <- Schema$traces[[tr$type %||% "scatter"]]$attributes
+        verify_attr(tr, spec)
+      })
     )
   }
 

R/toRGB.R

@@ -22,6 +22,17 @@
 toRGB <- function(x, alpha = 1) {
   if (length(x) == 0) return(x)
   if (any(x %in% "transparent")) return(x)
+  # allow x/alpha vector(s), but only sensible cases...
+  if (length(x) != length(alpha)) {
+    # try to reduce alpha to length 1 (in case x is of length 1)
+    alpha <- uniq(alpha)
+    if (length(x) != length(alpha) && length(alpha) != 1) {
+      stop(
+        "alpha must be of length 1 or the same length as x",
+        call. = FALSE
+      )
+    }
+  }
   # add alpha to already converted "rgb(x,y,z)" codes
   idx <- grepl("^rgba\\(", x) & alpha <= 1 & 0 <= alpha
   if (any(idx)) {

tests/testthat/test-animate-highlight.R

@@ -287,9 +287,6 @@ test_that("simple animation targeting works", {
     }
   }
 
-  
-  
-  
   # since all trace types are scatter, redraw = FALSE
   buttonArgs <- l$layout$updatemenus[[1]]$buttons[[1]]$args
   expect_false(buttonArgs[[2]]$frame$redraw)
@@ -298,7 +295,23 @@ test_that("simple animation targeting works", {
   res <- lapply(steps, function(s) {
     expect_false(s$args[[2]]$frame$redraw)
   })
+})
+
+test_that("animation frames are boxed up correctly", {
+  dallas <- subset(txhousing, city == "Dallas" & month == 1)
+  p <- ggplot(dallas) +
+    geom_point(aes(x = volume, y = sales, frame = year))
+  l <- plotly_build(p)$x
 
+  for (i in seq_along(l$frames)) {
+    traces <- l$frames[[i]]$data
+    for (j in seq_along(traces)) {
+      x <- traces[[j]]$x
+      y <- traces[[j]]$y
+      expect_true(length(x) > 1 || inherits(x, "AsIs"))
+      expect_true(length(y) > 1 || inherits(y, "AsIs"))
+    }
+  }
 
 })