Merge pull request #574 from ropensci/fix/axis-labels

use Plotly axis titles if not facetted

Author: cpsievert

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: plotly
 Title: Create Interactive Web Graphics via 'plotly.js'
-Version: 3.5.4
+Version: 3.5.5
 Authors@R: c(person("Carson", "Sievert", role = c("aut", "cre"),
     email = "[email protected]"),
     person("Chris", "Parmer", role = c("aut", "cph"),

NEWS

@@ -1,3 +1,15 @@
+3.5.5 -- 5 May 2016
+
+CHANGES:
+
+ggplotly() will now use plotly's layout.axisid.title (instead of 
+layout.annotations) for axis titles on non-faceted plots. 
+This will make for a better title placement experience (see #510).
+
+BUG FIX:
+
+Space for interior facet_wrap() strips are now accounted for.
+
 3.5.4 -- 5 May 2016
 
 BUG FIX:

R/ggplotly.R

@@ -277,6 +277,7 @@ gg2list <- function(p, width = NULL, height = NULL, tooltip = "all", source = "A
       theme[["strip.text.x"]] %||% theme[["strip.text"]],
       "npc", "height"
     )
+    panelMarginY <- panelMarginY + stripSize
     # space for ticks/text in free scales
     if (p$facet$free$x) {
       axisTicksX <- unitConvert(
@@ -307,7 +308,6 @@ gg2list <- function(p, width = NULL, height = NULL, tooltip = "all", source = "A
     rep(panelMarginX, 2),
     rep(panelMarginY, 2)
   )
-  
   doms <- get_domains(nPanels, nRows, margins)
 
   for (i in seq_len(nPanels)) {
@@ -335,6 +335,9 @@ gg2list <- function(p, width = NULL, height = NULL, tooltip = "all", source = "A
       }
       # type of unit conversion
       type <- if (xy == "x") "height" else "width"
+      # get axis title
+      axisTitleText <- sc$name %||% p$labels[[xy]] %||% ""
+      if (is_blank(axisTitle)) axisTitleText <- ""
       # https://plot.ly/r/reference/#layout-xaxis
       axisObj <- list(
         type = "linear",
@@ -350,7 +353,7 @@ gg2list <- function(p, width = NULL, height = NULL, tooltip = "all", source = "A
         ticklen = unitConvert(theme$axis.ticks.length, "pixels", type),
         tickwidth = unitConvert(axisTicks, "pixels", type),
         showticklabels = !is_blank(axisText),
-        tickfont = text2font(axisText, "height"),
+        tickfont = text2font(axisText, type),
         tickangle = - (axisText$angle %||% 0),
         showline = !is_blank(axisLine),
         linecolor = toRGB(axisLine$colour),
@@ -360,7 +363,9 @@ gg2list <- function(p, width = NULL, height = NULL, tooltip = "all", source = "A
         gridcolor = toRGB(panelGrid$colour),
         gridwidth = unitConvert(panelGrid, "pixels", type),
         zeroline = FALSE,
-        anchor = anchor
+        anchor = anchor,
+        title = axisTitleText,
+        titlefont = text2font(axisTitle)
       )
       # convert dates to milliseconds (86400000 = 24 * 60 * 60 * 1000)
       # this way both dates/datetimes are on same scale
@@ -380,27 +385,14 @@ gg2list <- function(p, width = NULL, height = NULL, tooltip = "all", source = "A
 
       # do some stuff that should be done once for the entire plot
       if (i == 1) {
-        # add space for exterior facet strips in `layout.margin`
-        if (has_facet(p)) {
-          stripSize <- unitConvert(stripText, "pixels", type)
-          if (xy == "x") {
-            gglayout$margin$t <- gglayout$margin$t + stripSize
-          }
-          if (xy == "y" && inherits(p$facet, "grid")) {
-            gglayout$margin$r <- gglayout$margin$r + stripSize
-          }
-        }
-        axisTitleText <- sc$name %||% p$labels[[xy]] %||% ""
-        if (is_blank(axisTitle)) axisTitleText <- ""
         axisTickText <- axisObj$ticktext[which.max(nchar(axisObj$ticktext))]
         side <- if (xy == "x") "b" else "l"
         # account for axis ticks, ticks text, and titles in plot margins
         # (apparently ggplot2 doesn't support axis.title/axis.text margins)
         gglayout$margin[[side]] <- gglayout$margin[[side]] + axisObj$ticklen +
           bbox(axisTickText, axisObj$tickangle, axisObj$tickfont$size)[[type]] +
           bbox(axisTitleText, axisTitle$angle, unitConvert(axisTitle, "pixels", type))[[type]]
-        # draw axis titles as annotations
-        # (plotly.js axis titles aren't smart enough to dodge ticks & text)
+        
         if (nchar(axisTitleText) > 0) {
           axisTextSize <- unitConvert(axisText, "npc", type)
           axisTitleSize <- unitConvert(axisTitle, "npc", type)
@@ -409,22 +401,41 @@ gg2list <- function(p, width = NULL, height = NULL, tooltip = "all", source = "A
                bbox(axisTickText, axisText$angle, axisTextSize)[[type]] -
                bbox(axisTitleText, axisTitle$angle, axisTitleSize)[[type]] / 2 -
                unitConvert(theme$axis.ticks.length, "npc", type))
-          # 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"
+        }
+        
+        # add space for exterior facet strips in `layout.margin`
+        if (has_facet(p)) {
+          stripSize <- unitConvert(stripText, "pixels", type)
+          if (xy == "x") {
+            gglayout$margin$t <- gglayout$margin$t + stripSize
+          }
+          if (xy == "y" && inherits(p$facet, "grid")) {
+            gglayout$margin$r <- gglayout$margin$r + stripSize
+          }
+          # facets have multiple axis objects, but only one title for the plot,
+          # so we empty the titles and try to draw the title as an annotation
+          if (nchar(axisTitleText) > 0) {
+            # 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"
+              )
             )
-          )
+          }
         }
       }
-
+      
+      if (has_facet(p)) {
+        gglayout[[axisName]]$title <- ""
+      }
+      
     } # end of axis loop
 
     xdom <- gglayout[[lay[, "xaxis"]]]$domain

tests/testthat/test-cookbook-axes.R

@@ -107,7 +107,7 @@ no.x.title <- bp +
 
 test_that("coord_fixed(ratio)", {
   info <- expect_traces(no.x.title, 1, "no-x-title")
-  expect_true(length(info$layout$annotations) == 1)
+  expect_identical(info$layout$xaxis$title, "")
 })
 
 # Also possible to set the axis label with the scale

tests/testthat/test-ggplot-labels.R

@@ -13,8 +13,8 @@ test_that("ylab is translated correctly", {
     geom_point(aes(Petal.Width, Sepal.Width)) +
     ylab("sepal width")
   info <- save_outputs(ggiris, "labels-ylab")
-  labs <- unlist(lapply(info$layout$annotations, "[[", "text"))
-  expect_identical(sort(labs), c("Petal.Width", "sepal width"))
+  labs <- c(info$layout$xaxis$title, info$layout$yaxis$title)
+  expect_identical(labs, c("Petal.Width", "sepal width"))
 })
 
 # TODO: why is this failing on R-devel???

tests/testthat/test-ggplot-legend.R

@@ -30,9 +30,9 @@ test_that("Discrete colour and shape get merged into one legend", {
     nms, paste0("(", d$vs, ",", d$cyl, ")")
   )
   a <- info$layout$annotations
-  expect_match(a[[3]]$text, "^factor\\(vs\\)")
-  expect_match(a[[3]]$text, "factor\\(cyl\\)$")
-  expect_true(a[[3]]$y > info$layout$legend$y)
+  expect_match(a[[1]]$text, "^factor\\(vs\\)")
+  expect_match(a[[1]]$text, "factor\\(cyl\\)$")
+  expect_true(a[[1]]$y > info$layout$legend$y)
 })