diff --git a/.travis.yml b/.travis.yml index 8091addbd1..98329875e3 100644 --- a/.travis.yml +++ b/.travis.yml @@ -24,7 +24,7 @@ cache: before_script: - mkdir -p "$R_LIBS_USER" - git config --global user.email "cpsievert1@gmail.com" - - git config --global user.name "Carson Sievert" + - git config --global user.name "cpsievert" - echo "Sys.setenv('plotly_username' = 'cpsievert')" > ~/.Rprofile - git clone https://github.com/cpsievert/plotly-test-table.git ../plotly-test-table - "wget -q -O - https://github.com/yihui/crandalf/raw/master/inst/scripts/install-pandoc | bash" diff --git a/DESCRIPTION b/DESCRIPTION index 2089a27455..8c809b557b 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: plotly Title: Create Interactive Web Graphics via Plotly's JavaScript Graphing Library -Version: 2.3.1 +Version: 2.3.2 Authors@R: c(person("Carson", "Sievert", role = c("aut", "cre"), email = "cpsievert1@gmail.com"), person("Chris", "Parmer", role = c("aut", "cph"), diff --git a/NEWS b/NEWS index 0cfb2aa175..7da08136e8 100644 --- a/NEWS +++ b/NEWS @@ -1,3 +1,7 @@ +2.3.2 -- 25 Jan 2015 + +More accurate list of data_array properties. Fixes #415 + 2.3.1 -- 25 Jan 2015 More accurate conversion of path width. Fixes #373. diff --git a/R/utils.R b/R/utils.R index 7b33882c71..ae502809ee 100644 --- a/R/utils.R +++ b/R/utils.R @@ -112,23 +112,56 @@ from_JSON <- function(x, ...) { jsonlite::fromJSON(x, simplifyDataFrame = FALSE, simplifyMatrix = FALSE, ...) } -# plotlyjs properties that must _always_ be an array (even if length 1) -get_boxed <- function() { - c("x", "y", "lat", "lon", "text") -} - add_boxed <- function(x) { for (i in seq_along(x$data)) { # some object keys require an array, even if length one # one way to ensure atomic vectors of length 1 are not automatically unboxed, # by to_JSON(), is to attach a class of AsIs (via I()) d <- x$data[[i]] - idx <- names(d) %in% get_boxed() & sapply(d, length) == 1 + idx <- names(d) %in% get_boxed(d$type %||% "scatter") & sapply(d, length) == 1 if (any(idx)) x$data[[i]][idx] <- lapply(d[idx], I) + # (safely) mark individual nested properties + x$data[[i]]$error_x$array <- i(d$error_x$array) + x$data[[i]]$error_y$array <- i(d$error_y$array) + x$data[[i]]$error_x$arrayminus <- i(d$error_x$arrayminus) + x$data[[i]]$error_y$arrayminus <- i(d$error_y$arrayminus) } x } +# plotlyjs properties that must _always_ be an array (even if length 1) +get_boxed <- function(type = "scatter") { + # if the trace type isn't found, provide some sensible defaults + boxers[[type]] %||% c("x", "y", "z", "lat", "lon", "text", "locations") +} + +# if this ever needs updating see +# https://github.com/ropensci/plotly/issues/415#issuecomment-173353138 +boxers <- list( + choropleth = c("locations", "z", "text"), + box = c("x", "y"), + heatmap = c("z", "text"), + histogram = c("x", "y"), + histogram2d = c("z", "color"), + mesh3d = c("x", "y", "z", "i", "j", "k", "intensity", "vertexcolor", "facecolor"), + # TODO: what to do about marker.colors? + pie = c("labels", "values", "text"), + scatter = c("x", "y", "r", "t"), + scatter3d = c("x", "y", "z"), + scattergeo = c("lon", "lat", "locations"), + surface = c("x", "y", "z", "text") +) + +i <- function(x) { + if (is.null(x)) { + return(NULL) + } else if (length(x) == 1) { + return(I(x)) + } else{ + return(x) + } +} + rm_asis <- function(x) { # jsonlite converts NULL to {} and NA to null (plotly prefers null to {}) # https://github.com/jeroenooms/jsonlite/issues/29 diff --git a/tests/testthat/test-ggplot-errorbar.R b/tests/testthat/test-ggplot-errorbar.R index 9e75789055..0d77c9fcee 100644 --- a/tests/testthat/test-ggplot-errorbar.R +++ b/tests/testthat/test-ggplot-errorbar.R @@ -16,3 +16,22 @@ test_that("geom_errorbar gives errorbars", { # right data for errorbar ymax expect_equal(L$data[[1]]$error_y$array, c(3.74, 1.26, 1.15)) }) + +df <- data.frame( + trt = factor(c(1, 1, 2, 2)), + resp = c(1, 5, 3, 4), + group = factor(c(1, 2, 3, 4)), + upper = c(1.1, 5.3, 3.3, 4.2), + lower = c(0.8, 4.6, 2.4, 3.6) +) + +p <- ggplot(df, aes(trt, resp, colour = group)) +g <- p + geom_errorbar(aes(ymin = lower, ymax = upper)) + +test_that("geom_errorbar boxes an array of length 1", { + L <- save_outputs(g, "errorbar-unique-groups") + expect_true(inherits(L$data[[1]]$error_y$array, "AsIs")) + expect_true(inherits(L$data[[1]]$error_y$arrayminus, "AsIs")) +}) + +# TODO fix and add a test for width of errorbars diff --git a/tests/testthat/test-plotly.R b/tests/testthat/test-plotly.R index 00bc271528..00da1103e5 100644 --- a/tests/testthat/test-plotly.R +++ b/tests/testthat/test-plotly.R @@ -111,3 +111,12 @@ test_that("inheriting properties works as expected", { expect_equal(l$data[[2]]$opacity, 0.5) expect_true(all(l$data[[1]]$y > l$data[[2]]$y)) }) + +test_that("x/y/z properties have a class of AsIs", { + p <- plot_ly(x = 1, y = 1, z = 1, type = "scatter3d") + l <- plotly_build(p) + tr <- l$data[[1]] + expect_true(inherits(tr$x, "AsIs")) + expect_true(inherits(tr$y, "AsIs")) + expect_true(inherits(tr$z, "AsIs")) +})