fix traceNames with frames (#1932)

* * fix traceNames

* update NEWS

* update tests figs from docker image

* remove type = "scatter" and update tests SVGs

Author: FrankBornais

NEWS.md

@@ -3,6 +3,7 @@
 ## BUG FIXES
 
 * `group_by.plotly()` now properly retains crosstalk information across `{dplyr}` versions (#1920).
+* Fixes some issues with `name` and `frames` when both attributes are specified. (#1903 and #1618).
 
 # 4.9.3
 

R/plotly_build.R

@@ -484,12 +484,14 @@ registerFrames <- function(p, frameMapping = NULL) {
     d <- lapply(d, function(tr) { tr$visible <- tr$visible %||% TRUE; tr })
 
     # if this frame is missing a trace name, supply an invisible one
-    traceNamesMissing <- setdiff(frameTraceNames, sapply(d, "[[", "name"))
+    traceNamesMissing <- setdiff(frameTraceNames, unlist(lapply(d, "[[", "name")))
     for (j in traceNamesMissing) {
       idx <- vapply(p$x$data, function(tr) isTRUE(tr[["name"]] == j), logical(1))
-      idx <- which(idx)[[1]]
-      invisible <- modify_list(p$x$data[[idx]], list(visible = FALSE))
-      d <- c(d, list(invisible))
+      if (any(idx)){
+        idx <- which(idx)[[1]]
+        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)),

tests/figs/density2d/density2d.svg

@@ -1,3 +1,3 @@
 - vdiffr-svg-engine: 1.0
 - vdiffr: 0.3.3.9000
-- freetypeharfbuzz: 0.2.5
+- freetypeharfbuzz: 0.2.6

tests/figs/deps.txt

@@ -79,3 +79,44 @@ test_that("adding trace name with frame does not throw frameOrder warning", {
 
 
 })
+
+test_that("adding trace name does not throw error", {
+  
+  #From ropensci/plotly/issues/1618
+  df <- data.frame(category=c('a', 'b', 'c', 'd', 'a', 'b', 'c', 'd'),
+                   year=c(2000, 2000, 2000, 2000, 2001, 2001, 2001, 2001),
+                   val_a=c(1,2,2,1,2,5,6,8),
+                   val_b=c(3,5,4,7,1,9,2,12))
+  
+  
+  p1 <- plot_ly(data = df, frame = ~year) %>%
+    add_markers(x = ~val_a, y = ~category, name = "Val_A", color = I("red")) %>%
+    add_markers(x = ~val_b, y = ~category, name = "Val_B", color = I("blue")) %>%
+    add_segments(x = ~val_a, xend = ~val_b, y = ~category, yend = ~category, showlegend=F) %>%
+    layout(
+      title = "Val A v Val B",
+      xaxis = list(title = "Value"), 
+      yaxis = list(title = ""),
+      margin = list(l = 65)
+      )  
+  
+  
+  expect_error(l <- plotly_build(p1), NA) 
+  
+  expect_equal(l$x$data[[1]]$name, "Val_A")
+  expect_equal(l$x$data[[2]]$name, "Val_B")
+  
+  
+  #From ropensci/plotly/issues/1903
+  df1 <- data.frame(frame = 1:10, x = 1:10, y = 0)
+  df2 <- data.frame(frame = rep(1:10, 1:10), 
+                    x = unlist(lapply(1:10, function(x) 1:x)),
+                    y = 1)
+  
+  p2 <-  plot_ly() %>%
+    add_trace(data = df1, type = "scatter", mode = "markers", x = ~x, y = ~y, frame = ~frame, name= "A") %>%
+    add_trace(data = df2, type = "scatter", mode = "lines", x = ~x, y = ~y, frame = ~frame, name = "B")
+  
+  expect_error(l1 <- plotly_build(p2), NA) 
+  
+})

tests/figs/geom-sf/sf-aspect.svg

@@ -302,9 +302,9 @@ test_that("image paper repositioning", {
 
 test_that("annotation xref/yref bumping", {
 
-  p1 <- plot_ly(mtcars, type = "scatter") %>%
+  p1 <- plot_ly(mtcars) %>%
     add_annotations(text = ~cyl, x = ~wt, y = ~mpg)
-  p2 <- plot_ly(mtcars, type = "scatter") %>%
+  p2 <- plot_ly(mtcars) %>%
     add_annotations(text = ~am, x = ~wt, y = ~mpg)
   s <- subplot(p1, p2)
   ann <- expect_doppelganger_built(s, "subplot-bump-axis-annotation")$layout$annotations
@@ -328,11 +328,11 @@ test_that("annotation xref/yref bumping", {
 
   # now, with more traces than annotations
   # https://github.com/ropensci/plotly/issues/1444
-  p1 <- plot_ly(type = "scatter") %>%
+  p1 <- plot_ly() %>%
     add_markers(x = 1, y = 1) %>%
     add_markers(x = 2, y = 2) %>%
     add_annotations(text = "foo", x = 1.5, y = 1.5)
-  p2 <- plot_ly(type = "scatter") %>%
+  p2 <- plot_ly() %>%
     add_markers(x = 1, y = 1) %>%
     add_markers(x = 2, y = 2) %>%
     add_annotations(text = "bar", x = 1.5, y = 1.5)