merge conflicts

Author: cpsievert

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: plotly
 Title: Create Interactive Web Graphics via 'plotly.js'
-Version: 4.5.5
+Version: 4.5.5.9000
 Authors@R: c(person("Carson", "Sievert", role = c("aut", "cre"),
     email = "cpsievert1@gmail.com"),
     person("Chris", "Parmer", role = c("aut", "cph"),

NEWS.md

@@ -1,3 +1,11 @@
+# 4.5.5.9000
+
+## BUG FIXES
+
+* When `height`/`width` are specified in `ggplotly()`, relative sizes are now translated correctly. Fixes #489 and #510.
+* More careful handling of font when expanding annotation arrays. Fixes #738.
+* Ignore data arrays of non-tidy traces. Fixes #737.
+
 # 4.5.5 -- 28 September 2016
 
 ## NEW FEATURES

R/ggplotly.R

@@ -115,6 +115,14 @@ gg2list <- function(p, width = NULL, height = NULL, tooltip = "all",
   # https://github.com/hadley/ggplot2/blob/0cd0ba/R/plot-build.r#L18-L92
   # ------------------------------------------------------------------------
 
+  # open a new graphics device, so we can convert relative sizes correctly
+  # if height/width is not specified, estimate it from the current device
+  deviceWidth <- width %||% unitConvert(grid::unit(1, "npc"), "pixels", "width")
+  deviceHeight <- height %||% unitConvert(grid::unit(1, "npc"), "pixels", "height")
+  tmpPlotFile <- tempfile(fileext = ".png")
+  grDevices::png(tmpPlotFile, width = deviceWidth, height = deviceHeight)
+  
+
   plot <- ggfun("plot_clone")(p)
   if (length(plot$layers) == 0) {
     plot <- plot + geom_blank()
@@ -480,14 +488,15 @@ gg2list <- function(p, width = NULL, height = NULL, tooltip = "all",
             # npc is on a 0-1 scale of the _entire_ device,
             # but these units _should_ be wrt to the plotting region
             # multiplying the offset by 2 seems to work, but this is a terrible hack
-            offset <- 1.75 * offset
             x <- if (xy == "x") 0.5 else offset
             y <- if (xy == "x") offset else 0.5
             gglayout$annotations <- c(
               gglayout$annotations,
               make_label(
                 faced(axisTitleText, axisTitle$face), x, y, el = axisTitle,
-                xanchor = "center", yanchor = "middle", annotationType = "axis"
+                xanchor = if (xy == "x") "center" else "right", 
+                yanchor = if (xy == "x") "top" else "center", 
+                annotationType = "axis"
               )
             )
           }
@@ -719,6 +728,11 @@ gg2list <- function(p, width = NULL, height = NULL, tooltip = "all",
   gglayout$width <- width
   gglayout$height <- height
 
+  # we're now done with converting units, turn off the device,
+  # and remove the temporary file
+  grDevices::dev.off()
+  unlink(tmpPlotFile)
+  
   l <- list(
     data = setNames(traces, NULL),
     layout = compact(gglayout),

R/plotly_build.R

@@ -43,9 +43,14 @@ plotly_build.plotly <- function(p) {
 
     # if an annotation attribute is an array, expand into multiple annotations 
     nAnnotations <- max(lengths(x$annotations) %||% 0)
+    # font is the only list object, so store it, and attach after transposing
+    font <- x$annotations[["font"]]
     x$annotations <- purrr::transpose(lapply(x$annotations, function(x) {
       as.list(rep(x, length.out = nAnnotations))
     }))
+    for (i in seq_len(nAnnotations)) {
+      x$annotations[[i]][["font"]] <- font
+    }
 
     x[lengths(x) > 0]
 
@@ -141,8 +146,8 @@ plotly_build.plotly <- function(p) {
     isArray <- lapply(Attrs, function(x) {
       tryCatch(identical(x[["valType"]], "data_array"), error = function(e) FALSE)
     })
-    # I don't think we ever want mesh3d's data attrs
-    dataArrayAttrs <- if (identical(trace[["type"]], "mesh3d")) NULL else names(Attrs)[as.logical(isArray)]
+    # "non-tidy" traces allow x/y of different lengths, so ignore those
+    dataArrayAttrs <- if (is_tidy(trace)) names(Attrs)[as.logical(isArray)]
     allAttrs <- c(
       dataArrayAttrs, special_attrs(trace), npscales(),
       # for some reason, text isn't listed as a data array in some traces

R/utils.R

@@ -47,6 +47,15 @@ getLevels <- function(x) {
   if (is.factor(x)) levels(x) else sort(unique(x))
 }
 
+# Don't attempt to do "tidy" data training on these trace types
+is_tidy <- function(trace) {
+  type <- trace[["type"]] %||% "scatter"
+  !type %in% c(
+    "mesh3d", "heatmap", "histogram2d", 
+    "histogram2dcontour", "contour", "surface"
+  )
+}
+
 # is grouping relevant for this geometry? (e.g., grouping doesn't effect a scatterplot)
 has_group <- function(trace) {
   inherits(trace, paste0("plotly_", c("segment", "path", "line", "polygon"))) ||