[pull] master from ropensci:master

DESCRIPTION

@@ -15,6 +15,8 @@ Authors@R: c(person("Carson", "Sievert", role = c("aut", "cre"),
     email = "[email protected]", comment = c(ORCID = "0000-0002-1994-3581")),
     person("Pedro", "Despouy", role = "aut",
     email = "[email protected]"),
+    person("Salim", "Brüggemann", role = "ctb",
+    email = "[email protected]", comment = c(ORCID = "0000-0002-5329-5987")),
     person("Plotly Technologies Inc.", role = "cph"))
 License: MIT + file LICENSE
 Description: Create interactive web graphics from 'ggplot2' graphs and/or a custom interface to the (MIT-licensed) JavaScript library 'plotly.js' inspired by the grammar of graphics.

NEWS.md

@@ -8,8 +8,12 @@
 
 * All HTTP requests are now retried upon failure (#1656)
 
+* R linebreaks (`\n`) in _factor labels_ are now translated to HTML linebreaks (`<br />`), too. Before, this conversion was only done for colums of type character. ([#1700](https://github.com/ropensci/plotly/pull/1700), @salim-b)
+
 ## BUG FIXES
 
+* `ggplotly()` now handles discrete axes of a `facet_wrap` and `facet_grid` correctly when there is only one category in panels > 1 (#1577 and #1720).
+
 * `ggplotly()` now handles `element_blank()` and `factor()` labels in positional scales correctly (#1731 and #1772).
 
 # 4.9.2.1

R/utils.R

@@ -521,7 +521,7 @@ verify_attr <- function(proposed, schema, layoutAttr = FALSE) {
 
     # do the same for "sub-attributes"
     if (identical(role, "object") && is.recursive(proposed[[attr]])) {
-      proposed[[attr]] <- verify_attr(proposed[[attr]], schema[[attr]], layoutAttr = layoutAttr)
+      proposed[[attr]] <- verify_attr(proposed[[attr]], attrSchema, layoutAttr = layoutAttr)
     }
   }
 
@@ -609,12 +609,14 @@ translate_linebreaks <- function(p) {
     typ <- typeof(a)
     if (typ == "list") {
       # retain the class of list elements 
-      # which important for many things, such as colorbars
+      # which is important for many things, such as colorbars
       a[] <- lapply(a, recurse)
     } else if (typ == "character" && !inherits(a, "JS_EVAL")) {
       attrs <- attributes(a)
       a <- gsub("\n", br(), a, fixed = TRUE)
       attributes(a) <- attrs
+    } else if (is.factor(a)) {
+      levels(a) <- gsub("\n", br(), levels(a), fixed = TRUE)
     }
     a
   }

tests/testthat/test-facet-axis.R

@@ -0,0 +1,15 @@
+test_that("ggplotly does not break discrete x-axis with facet_yyyy in panels > 1 with only one category", {
+  d <- data.frame(cat = c("A", "A", "A"), pan = paste("Panel", c(1, 2, 2)))
+  gp <- ggplot(d, aes(cat)) +
+    geom_bar() +
+    facet_wrap(~pan)
+  L <- plotly_build(ggplotly(gp))
+  # tickvals, ticktext and categoryarray have class 'AsIs'
+  lapply(L$x$layout[c("xaxis", "xaxis2")], function(axis) {
+    expect_s3_class(axis$tickvals, "AsIs")
+    expect_s3_class(axis$ticktext, "AsIs")
+    expect_true(axis$ticktext == "A")
+    expect_s3_class(axis$categoryarray, "AsIs")
+    expect_true(axis$categoryarray == "A")
+  })
+})

tests/testthat/test-plotly.R

@@ -317,3 +317,34 @@ test_that("toWebGL() shouldn't complain if it's already webgl", {
     toWebGL()
   expect_silent(plotly_build(p))
 })
+
+test_that("Line breaks are properly translated (R -> HTML)", {
+  # create target labels
+  suffix <- "\n\n(third line)\n(fourth line)"
+
+  target_labels <- iris$Species %>%
+    unique() %>%
+    paste0(suffix) %>%
+    gsub(pattern = "\n",
+         replacement = br(),
+         x = .,
+         fixed = TRUE)
+
+  # test factor column
+  d <- iris
+  levels(d$Species) <- paste0(levels(d$Species), suffix)
+  p1 <- d %>% plot_ly(x = ~Sepal.Length,
+                      y = ~Species)
+
+  expect_equivalent(plotly_build(p1)[["x"]][["layout"]][["yaxis"]][["categoryarray"]],
+                    target_labels)
+
+  # test character column
+  p2 <- d %>%
+    dplyr::mutate(Species = as.character(Species)) %>%
+    plot_ly(x = ~Sepal.Length,
+            y = ~Species)
+
+  expect_equivalent(plotly_build(p2)[["x"]][["layout"]][["yaxis"]][["categoryarray"]],
+                    target_labels)
+})