From 0f9fd8fa4f0cae96e64c011d4be3068c056adf8a Mon Sep 17 00:00:00 2001 From: michaelbabyn Date: Thu, 14 Mar 2019 12:46:27 -0400 Subject: [PATCH 1/3] dont srcify layout attributes --- R/utils.R | 8 ++++---- tests/testthat/test-api.R | 12 ++++++++---- 2 files changed, 12 insertions(+), 8 deletions(-) diff --git a/R/utils.R b/R/utils.R index 6b573eb95b..b6f1d82f98 100644 --- a/R/utils.R +++ b/R/utils.R @@ -444,7 +444,7 @@ verify_attr_names <- function(p) { verify_attr_spec <- function(p) { if (!is.null(p$x$layout)) { p$x$layout <- verify_attr( - p$x$layout, Schema$layout$layoutAttributes + p$x$layout, Schema$layout$layoutAttributes, layoutAttr = TRUE ) } for (tr in seq_along(p$x$data)) { @@ -459,7 +459,7 @@ verify_attr_spec <- function(p) { p } -verify_attr <- function(proposed, schema) { +verify_attr <- function(proposed, schema, layoutAttr = FALSE) { for (attr in names(proposed)) { attrSchema <- schema[[attr]] %||% schema[[sub("[0-9]+$", "", attr)]] # if schema is missing (i.e., this is an un-official attr), move along @@ -489,7 +489,7 @@ verify_attr <- function(proposed, schema) { # tag 'src-able' attributes (needed for api_create()) isSrcAble <- !is.null(schema[[paste0(attr, "src")]]) && length(proposed[[attr]]) > 1 - if (isDataArray || isSrcAble) { + if ((isDataArray || isSrcAble) && !isTRUE(layoutAttr)) { proposed[[attr]] <- structure(proposed[[attr]], apiSrc = TRUE) } @@ -517,7 +517,7 @@ verify_attr <- function(proposed, schema) { # do the same for "sub-attributes" if (identical(role, "object") && is.recursive(proposed[[attr]])) { - proposed[[attr]] <- verify_attr(proposed[[attr]], schema[[attr]]) + proposed[[attr]] <- verify_attr(proposed[[attr]], schema[[attr]], layoutAttr = layoutAttr) } } diff --git a/tests/testthat/test-api.R b/tests/testthat/test-api.R index 8a3b5e6cc9..841f01fd56 100644 --- a/tests/testthat/test-api.R +++ b/tests/testthat/test-api.R @@ -118,6 +118,10 @@ # expect_length(strsplit(x, ":")[[1]], 3) # } # +# expect_not_srcified <- function(x) { +# expect_true(is.null(x)) +# } +# # # src-ifies data arrays, but not arrayOk of length 1 # p <- plot_ly(x = 1:10, y = 1:10, marker = list(color = "red")) # res <- api_create(p) @@ -138,9 +142,9 @@ # api_create() # trace <- res$figure$frames[[1]]$data[[1]] # expect_srcified(trace$marker$colorsrc) -# -# # can src-ify layout.xaxis.tickvals +# +# # doesn't src-ify layout arrays (layout.xaxis.tickvals) # res <- api_create(ggplot() + geom_bar(aes(1:10))) -# expect_srcified(res$figure$layout$xaxis$tickvalssrc) -# +# expect_not_srcified(res$figure$layout$xaxis$tickvalssrc) +# # }) From cbcd9ded58c98981e46cd96afeaef38c85b10ae2 Mon Sep 17 00:00:00 2001 From: Carson Sievert Date: Wed, 3 Apr 2019 10:26:36 -0500 Subject: [PATCH 2/3] resurface api tests --- tests/testthat/test-api.R | 300 +++++++++++++++++++------------------- 1 file changed, 150 insertions(+), 150 deletions(-) diff --git a/tests/testthat/test-api.R b/tests/testthat/test-api.R index 841f01fd56..1877ccd21f 100644 --- a/tests/testthat/test-api.R +++ b/tests/testthat/test-api.R @@ -1,150 +1,150 @@ -# context("api") -# -# test_that("api() returns endpoints", { -# skip_on_cran() -# skip_if_not_master() -# -# res <- api() -# expect_true(length(res) > 1) -# expect_true(all(c("plots", "grids", "folders") %in% names(res))) -# }) -# -# test_that("Can search with white-space", { -# skip_on_cran() -# skip_if_not_master() -# -# res <- api("search?q=overdose drugs") -# expect_true(length(res) > 1) -# }) -# -# test_that("Changing a filename works", { -# skip_on_cran() -# skip_if_not_master() -# -# id <- plotly:::new_id() -# f <- api("files/cpsievert:14680", "PATCH", list(filename = id)) -# expect_equivalent(f$filename, id) -# }) -# -# -# test_that("Downloading plots works", { -# skip_on_cran() -# skip_if_not_master() -# -# # https://plot.ly/~cpsievert/200 -# p <- api_download_plot(200, "cpsievert") -# expect_is(p, "htmlwidget") -# expect_is(p, "plotly") -# -# l <- plotly_build(p)$x -# expect_length(l$data, 1) -# -# # This file is a grid, not a plot https://plot.ly/~cpsievert/14681 -# expect_error( -# api_download_plot(14681, "cpsievert"), "grid" -# ) -# }) -# -# -# test_that("Downloading grids works", { -# skip_on_cran() -# skip_if_not_master() -# -# g <- api_download_grid(14681, "cpsievert") -# expect_is(g, "api_file") -# expect_is( -# tibble::as_tibble(g$preview), "data.frame" -# ) -# -# # This file is a plot, not a grid https://plot.ly/~cpsievert/14681 -# expect_error( -# api_download_grid(200, "cpsievert"), "plot" -# ) -# }) -# -# -# test_that("Creating produces a new file by default", { -# skip_on_cran() -# skip_if_not_master() -# -# expect_new <- function(obj) { -# old <- api("folders/home?user=cpsievert") -# new_obj <- api_create(obj) -# Sys.sleep(3) -# new <- api("folders/home?user=cpsievert") -# n <- if (plotly:::is.plot(new_obj)) 2 else 1 -# expect_equivalent(old$children$count + n, new$children$count) -# } -# -# expect_new(mtcars) -# # even if plot has multiple traces, only one grid should be created -# p1 <- plot_ly(mtcars, x = ~mpg, y = ~wt) -# p2 <- add_markers(p1, color = ~factor(cyl)) -# p3 <- add_markers(p1, color = ~factor(cyl), frame = ~factor(vs)) -# expect_new(p1) -# expect_new(p2) -# expect_new(p3) -# }) -# -# -# test_that("Can overwrite a grid", { -# skip_on_cran() -# skip_if_not_master() -# -# id <- new_id() -# m <- api_create(mtcars, id) -# m2 <- api_create(iris, id) -# expect_true(identical(m$embed_url, m2$embed_url)) -# expect_false(identical(m$cols, m2$cols)) -# }) -# -# test_that("Can overwrite a plot", { -# skip_on_cran() -# skip_if_not_master() -# -# id <- new_id() -# p <- plot_ly() -# m <- api_create(p, id) -# m2 <- api_create(layout(p, title = "test"), id) -# expect_true(identical(m$embed_url, m2$embed_url)) -# expect_false(identical(m$figure$layout$title, m2$figure$layout$title)) -# }) -# -# test_that("Can create plots with non-trivial src attributes", { -# skip_on_cran() -# skip_if_not_master() -# -# expect_srcified <- function(x) { -# expect_length(strsplit(x, ":")[[1]], 3) -# } -# -# expect_not_srcified <- function(x) { -# expect_true(is.null(x)) -# } -# -# # src-ifies data arrays, but not arrayOk of length 1 -# p <- plot_ly(x = 1:10, y = 1:10, marker = list(color = "red")) -# res <- api_create(p) -# trace <- res$figure$data[[1]] -# expect_srcified(trace$xsrc) -# expect_srcified(trace$ysrc) -# expect_true(trace$marker$color == "red") -# -# # can src-ify data[i].marker.color -# p <- plot_ly(x = 1:10, y = 1:10, color = 1:10) -# res <- api_create(p) -# trace <- res$figure$data[[1]] -# expect_srcified(trace$marker$colorsrc) -# -# # can src-ify frames[i].data[i].marker.color -# res <- p %>% -# add_markers(frame = rep(1:2, 5)) %>% -# api_create() -# trace <- res$figure$frames[[1]]$data[[1]] -# expect_srcified(trace$marker$colorsrc) -# -# # doesn't src-ify layout arrays (layout.xaxis.tickvals) -# res <- api_create(ggplot() + geom_bar(aes(1:10))) -# expect_not_srcified(res$figure$layout$xaxis$tickvalssrc) -# -# }) +context("api") + +test_that("api() returns endpoints", { + skip_on_cran() + skip_if_not_master() + + res <- api() + expect_true(length(res) > 1) + expect_true(all(c("plots", "grids", "folders") %in% names(res))) +}) + +test_that("Can search with white-space", { + skip_on_cran() + skip_if_not_master() + + res <- api("search?q=overdose drugs") + expect_true(length(res) > 1) +}) + +test_that("Changing a filename works", { + skip_on_cran() + skip_if_not_master() + + id <- plotly:::new_id() + f <- api("files/cpsievert:14680", "PATCH", list(filename = id)) + expect_equivalent(f$filename, id) +}) + + +test_that("Downloading plots works", { + skip_on_cran() + skip_if_not_master() + + # https://plot.ly/~cpsievert/200 + p <- api_download_plot(200, "cpsievert") + expect_is(p, "htmlwidget") + expect_is(p, "plotly") + + l <- plotly_build(p)$x + expect_length(l$data, 1) + + # This file is a grid, not a plot https://plot.ly/~cpsievert/14681 + expect_error( + api_download_plot(14681, "cpsievert"), "grid" + ) +}) + + +test_that("Downloading grids works", { + skip_on_cran() + skip_if_not_master() + + g <- api_download_grid(14681, "cpsievert") + expect_is(g, "api_file") + expect_is( + tibble::as_tibble(g$preview), "data.frame" + ) + + # This file is a plot, not a grid https://plot.ly/~cpsievert/14681 + expect_error( + api_download_grid(200, "cpsievert"), "plot" + ) +}) + + +test_that("Creating produces a new file by default", { + skip_on_cran() + skip_if_not_master() + + expect_new <- function(obj) { + old <- api("folders/home?user=cpsievert") + new_obj <- api_create(obj) + Sys.sleep(3) + new <- api("folders/home?user=cpsievert") + n <- if (plotly:::is.plot(new_obj)) 2 else 1 + expect_equivalent(old$children$count + n, new$children$count) + } + + expect_new(mtcars) + # even if plot has multiple traces, only one grid should be created + p1 <- plot_ly(mtcars, x = ~mpg, y = ~wt) + p2 <- add_markers(p1, color = ~factor(cyl)) + p3 <- add_markers(p1, color = ~factor(cyl), frame = ~factor(vs)) + expect_new(p1) + expect_new(p2) + expect_new(p3) +}) + + +test_that("Can overwrite a grid", { + skip_on_cran() + skip_if_not_master() + + id <- new_id() + m <- api_create(mtcars, id) + m2 <- api_create(iris, id) + expect_true(identical(m$embed_url, m2$embed_url)) + expect_false(identical(m$cols, m2$cols)) +}) + +test_that("Can overwrite a plot", { + skip_on_cran() + skip_if_not_master() + + id <- new_id() + p <- plot_ly() + m <- api_create(p, id) + m2 <- api_create(layout(p, title = "test"), id) + expect_true(identical(m$embed_url, m2$embed_url)) + expect_false(identical(m$figure$layout$title, m2$figure$layout$title)) +}) + +test_that("Can create plots with non-trivial src attributes", { + skip_on_cran() + skip_if_not_master() + + expect_srcified <- function(x) { + expect_length(strsplit(x, ":")[[1]], 3) + } + + expect_not_srcified <- function(x) { + expect_true(is.null(x)) + } + + # src-ifies data arrays, but not arrayOk of length 1 + p <- plot_ly(x = 1:10, y = 1:10, marker = list(color = "red")) + res <- api_create(p) + trace <- res$figure$data[[1]] + expect_srcified(trace$xsrc) + expect_srcified(trace$ysrc) + expect_true(trace$marker$color == "red") + + # can src-ify data[i].marker.color + p <- plot_ly(x = 1:10, y = 1:10, color = 1:10) + res <- api_create(p) + trace <- res$figure$data[[1]] + expect_srcified(trace$marker$colorsrc) + + # can src-ify frames[i].data[i].marker.color + res <- p %>% + add_markers(frame = rep(1:2, 5)) %>% + api_create() + trace <- res$figure$frames[[1]]$data[[1]] + expect_srcified(trace$marker$colorsrc) + + # doesn't src-ify layout arrays (layout.xaxis.tickvals) + res <- api_create(ggplot() + geom_bar(aes(1:10))) + expect_not_srcified(res$figure$layout$xaxis$tickvalssrc) + +}) From fed201743109f595ba1f66d432191d48f5313d70 Mon Sep 17 00:00:00 2001 From: Carson Sievert Date: Wed, 3 Apr 2019 10:57:24 -0500 Subject: [PATCH 3/3] add a comment --- R/utils.R | 2 ++ 1 file changed, 2 insertions(+) diff --git a/R/utils.R b/R/utils.R index b6f1d82f98..7113ed036d 100644 --- a/R/utils.R +++ b/R/utils.R @@ -488,6 +488,8 @@ verify_attr <- function(proposed, schema, layoutAttr = FALSE) { } # tag 'src-able' attributes (needed for api_create()) + # note that layout has 'src-able' attributes that shouldn't + # be turned into grids https://github.com/ropensci/plotly/pull/1489 isSrcAble <- !is.null(schema[[paste0(attr, "src")]]) && length(proposed[[attr]]) > 1 if ((isDataArray || isSrcAble) && !isTRUE(layoutAttr)) { proposed[[attr]] <- structure(proposed[[attr]], apiSrc = TRUE)