Skip to content

DS-4804 Fixup and add unit test #20

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Merged
merged 8 commits into from
Jul 14, 2023
Merged

DS-4804 Fixup and add unit test #20

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
8 commits
Select commit Hold shift + click to select a range
6ef95b7
DS-4804 Fixup and add unit test
jrwishart Jul 14, 2023
9603940
DS-4804 Use CircleCI instead of actions
jrwishart Jul 14, 2023
135887d
DS-4804 Prod CCI
jrwishart Jul 14, 2023
c3259d3
DS-4804 Try viz CCI config
jrwishart Jul 14, 2023
c14b8b2
DS-4804 don't split job
jrwishart Jul 14, 2023
8088bdc
DS-4804 Remove CCI for now
jrwishart Jul 14, 2023
39337c2
DS-4804 Real fix this time
jrwishart Jul 14, 2023
b95fd2f
DS-4804 Allow test to work on earlier R versions
jrwishart Jul 14, 2023
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
1 change: 1 addition & 0 deletions .Rbuildignore
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -21,3 +21,4 @@ README.Rmd
abbvie.R
^\.httr-oauth$
^\.github$
^\.circleci$
3 changes: 2 additions & 1 deletion R/plotly.R
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
16 changes: 16 additions & 0 deletions tests/testthat/test-plotly.R
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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)
})