From 887372eae9c616a043bf797dfdcd89ea1e6e0b95 Mon Sep 17 00:00:00 2001
From: cpsievert <cpsievert1@gmail.com>
Date: Wed, 20 Jan 2016 21:24:28 -0600
Subject: [PATCH 1/7] more accurate list of data_array properties. fixes #415

---
 R/utils.R | 30 ++++++++++++++++++++++++------
 1 file changed, 24 insertions(+), 6 deletions(-)

diff --git a/R/utils.R b/R/utils.R
index 7b33882c71..0539e61a80 100644
--- a/R/utils.R
+++ b/R/utils.R
@@ -112,23 +112,41 @@ 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)
   }
   x
 }
 
+# plotlyjs properties that must _always_ be an array (even if length 1)
+get_boxed <- function(type = "scatter") {
+  boxers[[type]]
+}
+
+# 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")
+)
+
+
 rm_asis <- function(x) {
   # jsonlite converts NULL to {} and NA to null (plotly prefers null to {})
   # https://github.com/jeroenooms/jsonlite/issues/29

From 94aa22a48d2b7c3c74284221c665d1038ae5a531 Mon Sep 17 00:00:00 2001
From: cpsievert <cpsievert1@gmail.com>
Date: Wed, 20 Jan 2016 21:35:41 -0600
Subject: [PATCH 2/7] bump version; update news

---
 .travis.yml | 2 ++
 DESCRIPTION | 2 +-
 NEWS        | 4 ++++
 3 files changed, 7 insertions(+), 1 deletion(-)

diff --git a/.travis.yml b/.travis.yml
index c0682b22b6..0b6d30d9da 100644
--- a/.travis.yml
+++ b/.travis.yml
@@ -24,6 +24,8 @@ cache:
 
 before_script:
   - mkdir -p "$R_LIBS_USER"
+  - git config --global user.email "cpsievert1@gmail.com"
+  - 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 70227bb4e6..2089a27455 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.0
+Version: 2.3.1
 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 303d11692c..88d3c50579 100644
--- a/NEWS
+++ b/NEWS
@@ -1,3 +1,7 @@
+2.3.1 -- 20 Jan 2015
+
+more accurate list of data_array properties. fixes #415
+
 2.3.0 -- 19 Jan 2015
 
 Add sharing argument and deprecate world_readable. Fixes #332

From 873f476363077b83d2b89e4b47869f64dbc60634 Mon Sep 17 00:00:00 2001
From: cpsievert <cpsievert1@gmail.com>
Date: Fri, 22 Jan 2016 12:30:21 -0600
Subject: [PATCH 3/7] if the trace type isn't found, provide some sensible
 defaults

---
 R/utils.R | 3 ++-
 1 file changed, 2 insertions(+), 1 deletion(-)

diff --git a/R/utils.R b/R/utils.R
index 0539e61a80..a5e9447021 100644
--- a/R/utils.R
+++ b/R/utils.R
@@ -126,7 +126,8 @@ add_boxed <- function(x) {
 
 # plotlyjs properties that must _always_ be an array (even if length 1)
 get_boxed <- function(type = "scatter") {
-  boxers[[type]]
+  # 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

From b6a541e1091546ee74f7458255763aa650e1d680 Mon Sep 17 00:00:00 2001
From: cpsievert <cpsievert1@gmail.com>
Date: Mon, 25 Jan 2016 15:47:35 -0600
Subject: [PATCH 4/7] (safely) mark individual nested properties

---
 R/utils.R | 22 ++++++++++++++++++++++
 1 file changed, 22 insertions(+)

diff --git a/R/utils.R b/R/utils.R
index a5e9447021..85e247f371 100644
--- a/R/utils.R
+++ b/R/utils.R
@@ -120,6 +120,11 @@ add_boxed <- function(x) {
     d <- x$data[[i]]
     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
+    d$error_x$array <- i(d$error_x$array)
+    d$error_y$array <- i(d$error_y$array)
+    d$error_x$arrayminus <- i(d$error_x$arrayminus)
+    d$error_y$arrayminus <- i(d$error_y$arrayminus)
   }
   x
 }
@@ -147,6 +152,23 @@ boxers <- list(
   surface = c("x", "y", "z", "text")
 )
 
+i <- function(x) if (is.null(x)) x else I(x)
+
+#' Pick an element from a nested list
+#' @param x a list
+#' @param nms a character vector specifying a search path
+#' @example
+#' x <- list(a = list(b = list(c = "Come and get it!")))
+#' pick(x, c("a", "b", "c"))
+#' #> [1] "Come and get it!"
+pick <- function(x, nms) {
+  for (i in seq_along(nms)) {
+    nm <- nms[i]
+    x <- x[[nm]]
+  }
+  x
+}
+
 
 rm_asis <- function(x) {
   # jsonlite converts NULL to {} and NA to null (plotly prefers null to {})

From a1c70b445ca932710eb4077189cc9480bbaa0234 Mon Sep 17 00:00:00 2001
From: cpsievert <cpsievert1@gmail.com>
Date: Mon, 25 Jan 2016 16:16:07 -0600
Subject: [PATCH 5/7] add a simple test

---
 R/utils.R                    | 24 ++++--------------------
 tests/testthat/test-plotly.R |  9 +++++++++
 2 files changed, 13 insertions(+), 20 deletions(-)

diff --git a/R/utils.R b/R/utils.R
index 85e247f371..7cf9656420 100644
--- a/R/utils.R
+++ b/R/utils.R
@@ -121,10 +121,10 @@ add_boxed <- function(x) {
     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
-    d$error_x$array <- i(d$error_x$array)
-    d$error_y$array <- i(d$error_y$array)
-    d$error_x$arrayminus <- i(d$error_x$arrayminus)
-    d$error_y$arrayminus <- i(d$error_y$arrayminus)
+    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
 }
@@ -154,22 +154,6 @@ boxers <- list(
 
 i <- function(x) if (is.null(x)) x else I(x)
 
-#' Pick an element from a nested list
-#' @param x a list
-#' @param nms a character vector specifying a search path
-#' @example
-#' x <- list(a = list(b = list(c = "Come and get it!")))
-#' pick(x, c("a", "b", "c"))
-#' #> [1] "Come and get it!"
-pick <- function(x, nms) {
-  for (i in seq_along(nms)) {
-    nm <- nms[i]
-    x <- x[[nm]]
-  }
-  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-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"))
+})

From 2fb00ff172f5615614e4025ad616d03b6827916e Mon Sep 17 00:00:00 2001
From: cpsievert <cpsievert1@gmail.com>
Date: Mon, 25 Jan 2016 16:25:53 -0600
Subject: [PATCH 6/7] demonstrate with a test that we also fixed #424

---
 tests/testthat/test-ggplot-errorbar.R | 19 +++++++++++++++++++
 1 file changed, 19 insertions(+)

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

From 02350bb978d202321c1ef136693f207285af024c Mon Sep 17 00:00:00 2001
From: cpsievert <cpsievert1@gmail.com>
Date: Mon, 25 Jan 2016 16:35:13 -0600
Subject: [PATCH 7/7] only attach AsIs to length 1 vectors to make expect_equal
 happy

---
 R/utils.R | 10 +++++++++-
 1 file changed, 9 insertions(+), 1 deletion(-)

diff --git a/R/utils.R b/R/utils.R
index 7cf9656420..ae502809ee 100644
--- a/R/utils.R
+++ b/R/utils.R
@@ -152,7 +152,15 @@ boxers <- list(
   surface = c("x", "y", "z", "text")
 )
 
-i <- function(x) if (is.null(x)) x else I(x)
+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 {})