Merge pull request #20 from Displayr/DS-4804-2

DS-4804 Fixup and add unit test

Author: mwmclean

.Rbuildignore

@@ -21,3 +21,4 @@ README.Rmd
 abbvie.R
 ^\.httr-oauth$
 ^\.github$
+^\.circleci$

R/plotly.R

@@ -140,10 +140,11 @@ plot_ly <- function(data = data.frame(), ..., type = NULL, name,
   if (!is.data.frame(data) && !crosstalk::is.SharedData(data)) {
     stop("First argument, `data`, must be a data frame or shared data.", call. = FALSE)
   }
+
   if (is.data.frame(data) && nrow(data) > 0L) {
     qtables <- vapply(data, inherits, logical(1L), c("qTable", "QTable"))
     if (any(qtables))
-      data[qtables] <- lapply(data[qtables], unclass)
+      data[qtables] <- lapply(data[qtables], as.vector)
   }
 
   # "native" plotly arguments

tests/testthat/test-plotly.R

@@ -358,3 +358,19 @@ test_that("Line breaks are properly translated (R -> HTML)", {
 test_that("group_by() on a plotly object doesn't produce warning", {
    expect_warning(group_by(plot_ly(txhousing), city), NA)
 })
+
+test_that("Check QTables dont cause errors", {
+    s <- data.frame(
+        x = array(runif(n), dim = n),
+        x2 = array(runif(n), dim = n),
+        y = factor(letters[1:10])
+    )
+    class(s[[1]]) <- "QTable"
+    class(s[[2]]) <- "qTable"
+    expect_error(p <- plot_ly(s) |>
+        add_segments(x = ~x, xend = ~x2, y = ~y, yend = ~y, showlegend = FALSE) |>
+        add_markers(x = ~x, xend = ~y, y = ~y, name = "foo", color = I("orange"), showlegend = FALSE) |>
+        add_markers(x = ~x2, xend = ~y, y = ~y, name = "bar", color = I("blue"), showlegend = FALSE),
+    NA)
+    expect_error(print(p), NA)
+})