Fix #2281: geom_blank no longer drops legend for other geoms

Author: cpsievert

NEWS.md

@@ -32,6 +32,7 @@ See the [plotly.js releases page](https://github.com/plotly/plotly.js/releases)
 * Closed #2305: `ggplotly()` now respects `geom_boxplot(outlier.shape = NA)` to hide outlier points.
 * Closed #2467: `ggplotly()` now correctly shows legends and splits traces when scales have multiple aesthetics.
 * Closed #2407, #2187: `ggplotly()` now translates `legend.position` theme element to plotly layout (supports "bottom", "top", "left", and numeric positions).
+* Closed #2281: `ggplotly()` no longer drops legends when `geom_blank()` is present in the plot.
 
 # plotly 4.11.0
 

R/ggplotly.R

@@ -411,7 +411,6 @@ gg2list <- function(p, width = NULL, height = NULL,
       # of each non-positional scale for display in tooltips
       for (sc in npscales$scales) {
         data <- lapply(data, function(d) {
-          # Only process aesthetics that actually exist in this layer's data
           present_aes <- intersect(sc$aesthetics, names(d))
           if (length(present_aes) > 0) {
             d[paste0(present_aes, "_plotlyDomain")] <- d[present_aes]
@@ -573,13 +572,15 @@ gg2list <- function(p, width = NULL, height = NULL,
     tr$hoverinfo <- tr$hoverinfo %||%"text"
     tr
   })
-  # show only one legend entry per legendgroup
+  # show only one legend entry per legendgroup (skip invisible traces for dedup)
   grps <- sapply(traces, "[[", "legendgroup")
+  is_visible <- sapply(traces, function(tr) !isFALSE(tr$visible))
+  grps_for_dedup <- ifelse(is_visible, grps, paste0(grps, "_invisible_", seq_along(grps)))
   traces <- Map(function(x, y) {
     if (!is.null(x[["frame"]])) return(x)
     x$showlegend <- isTRUE(x$showlegend) && y
     x
-  }, traces, !duplicated(grps))
+  }, traces, !duplicated(grps_for_dedup))
 
   # ------------------------------------------------------------------------
   # axis/facet/margin conversion
@@ -985,7 +986,7 @@ gg2list <- function(p, width = NULL, height = NULL,
     font = text2font(theme$legend.text)
   )
 
-  # Translate legend.position from ggplot2 theme to plotly layout (fixes #2407, #2187)
+  # Translate legend.position to plotly layout
   legend_pos <- theme$legend.position %||% theme[["legend.position"]]
   if (!is.null(legend_pos) && !identical(legend_pos, "none")) {
     if (is.character(legend_pos)) {
@@ -1000,7 +1001,6 @@ gg2list <- function(p, width = NULL, height = NULL,
           x = -0.15, y = 0.5, xanchor = "right", yanchor = "middle"
         )),
         "inside" = {
-          # In ggplot2 >= 3.5.0, numeric position is stored in legend.position.inside
           inside_pos <- theme$legend.position.inside %||% theme[["legend.position.inside"]]
           if (is.numeric(inside_pos) && length(inside_pos) == 2) {
             modifyList(gglayout$legend, list(
@@ -1010,10 +1010,9 @@ gg2list <- function(p, width = NULL, height = NULL,
             gglayout$legend
           }
         },
-        gglayout$legend  # "right" is default, no change needed
+        gglayout$legend
       )
     } else if (is.numeric(legend_pos) && length(legend_pos) == 2) {
-      # Handle numeric position like c(0.8, 0.2) for older ggplot2 versions
       gglayout$legend <- modifyList(gglayout$legend, list(
         x = legend_pos[1], y = legend_pos[2], xanchor = "left", yanchor = "bottom"
       ))

R/layers2traces.R

@@ -56,9 +56,7 @@ layers2traces <- function(data, prestats_data, layout, p) {
       if (!aesName %in% names(x)) next
       # TODO: should we be getting the name from scale_*(name) first?
       varName <- y[[i]]
-      # Skip auto-generated group aesthetic (where both aes name and var name are "group"),
-      # but allow: (1) variables named "group" mapped to other aesthetics like colour,
-      # and (2) other variables mapped to the "group" aesthetic
+      # Skip auto-generated group aesthetic, but keep explicit group mappings
       if (identical(aesName, "group") && identical(varName, "group")) next
       # add a line break if hovertext already exists
       if ("hovertext" %in% names(x)) x$hovertext <- paste0(x$hovertext, br())
@@ -77,11 +75,7 @@ layers2traces <- function(data, prestats_data, layout, p) {
     x
   }, data, hoverTextAes)
 
-  # draw legends only for discrete scales
-  # Register each aesthetic separately for proper legend matching (fixes #2467)
-  # When a scale has multiple aesthetics (e.g., c("colour", "fill")), we need
-  # individual entries so "colour_plotlyDomain" matches discreteScales[["colour"]]
-  # Skip identity scales (guide = "none") as they don't produce legends or trace splitting
+  # draw legends only for discrete scales (skip scales with guide = "none")
   discreteScales <- list()
   for (sc in p$scales$non_position_scales()$scales) {
     if (sc$is_discrete() && !identical(sc$guide, "none")) {
@@ -713,7 +707,7 @@ geom2trace <- function(data, params, p) {
 
 #' @export
 geom2trace.GeomBlank <- function(data, params, p) {
-  list(visible = FALSE)
+  list(visible = FALSE, showlegend = FALSE)
 }
 
 #' @export
@@ -877,11 +871,7 @@ geom2trace.GeomBoxplot <- function(data, params, p) {
   # marker styling must inherit from GeomPoint$default_aes
   # https://github.com/hadley/ggplot2/blob/ab42c2ca81458b0cf78e3ba47ed5db21f4d0fc30/NEWS#L73-L7
   point_defaults <- GeomPoint$use_defaults(NULL)
-
-  # Determine if outliers should be hidden
-  # Hide outliers if: outliers = FALSE, or outlier.shape = NA (via outlier_gp$shape)
-  hide_outliers <- isFALSE(params$outliers) ||
-    isTRUE(is.na(params$outlier_gp$shape))
+  hide_outliers <- isFALSE(params$outliers) || isTRUE(is.na(params$outlier_gp$shape))
 
   compact(list(
     x = data[["x"]],
@@ -896,7 +886,6 @@ geom2trace.GeomBoxplot <- function(data, params, p) {
       aes2plotly(data, params, "fill"),
       aes2plotly(data, params, "alpha")
     ),
-    # Control whether outlier points are shown
     boxpoints = if (hide_outliers) FALSE,
     # markers/points
     marker = list(

tests/testthat/test-ggplot-blank.R

@@ -3,13 +3,31 @@ test_that("geom_blank", {
   skip_if_not_installed("ggplot2", "3.4.0")
   qp <- expect_warning(qplot(), "deprecated")
   l <- ggplotly(qp)$x
-  
+
   expect_length(l$data, 1)
   expect_false(l$data[[1]]$visible)
-  
+
   l <- ggplotly(ggplot())$x
-  
+
   expect_length(l$data, 1)
   expect_false(l$data[[1]]$visible)
-  
+
+})
+
+test_that("geom_blank does not drop legend (#2281)", {
+  # When geom_blank() is combined with other geoms, legend should still appear
+  p <- ggplot(iris, aes(Sepal.Length, Sepal.Width, col = Species)) +
+    geom_blank() +
+    geom_point()
+
+  L <- plotly_build(ggplotly(p))$x
+
+  # geom_point should create 3 visible traces with legend
+  visible_traces <- Filter(function(d) !isFALSE(d$visible) && d$type == "scatter", L$data)
+  expect_equal(length(visible_traces), 3)
+  expect_true(any(sapply(visible_traces, function(d) isTRUE(d$showlegend))))
+
+  # Trace names should be species names
+  trace_names <- sapply(visible_traces, function(d) d$name)
+  expect_true(all(c("setosa", "versicolor", "virginica") %in% trace_names))
 })