diff --git a/DESCRIPTION b/DESCRIPTION index 6bf5f1986f..c31479e423 100644 --- a/DESCRIPTION +++ b/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 = "cpsievert1@gmail.com"), person("Chris", "Parmer", role = c("aut", "cph"), diff --git a/NEWS b/NEWS index c2372258b3..a21e866aac 100644 --- a/NEWS +++ b/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: diff --git a/R/ggplotly.R b/R/ggplotly.R index 14feafdf25..2e9556b9d5 100644 --- a/R/ggplotly.R +++ b/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,18 +385,6 @@ 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 @@ -399,8 +392,7 @@ gg2list <- function(p, width = NULL, height = NULL, tooltip = "all", source = "A 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 diff --git a/tests/testthat/test-cookbook-axes.R b/tests/testthat/test-cookbook-axes.R index 031fd18b6b..e01117c173 100644 --- a/tests/testthat/test-cookbook-axes.R +++ b/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 diff --git a/tests/testthat/test-ggplot-labels.R b/tests/testthat/test-ggplot-labels.R index 2da9741382..723b93484c 100644 --- a/tests/testthat/test-ggplot-labels.R +++ b/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??? diff --git a/tests/testthat/test-ggplot-legend.R b/tests/testthat/test-ggplot-legend.R index 958799dc1f..f161577c74 100644 --- a/tests/testthat/test-ggplot-legend.R +++ b/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) })