Avoid legend duplication in plotly conversion from ggplot with facet_wrap

Question

Consider the plot produced by the following reprex. Note that the ggplot has sensible legends, while in plotly, the legend is heavily duplicated, with one entry for each time the same category ("manufacturer") appears in each facet. How do I make the plotly legend better match that of the ggplot2 one?

library(plotly)
library(ggplot2)

p <- mpg %>% 
  ggplot(aes(year)) +
  geom_ribbon(aes(ymin=cty, ymax=hwy, fill = manufacturer), alpha=0.2) + 
  geom_line(aes(y = hwy, col=manufacturer))  +
  facet_wrap(~class)
p

plotly::ggplotly(p)

Answer 1

Adapting my answer on this post to your case (which draws on this answer) one option would be to manipulate the plotly object.

The issue is that with facetting we end up with one legend entry for each facet in which a group is present, i.e. the numbers in the legend entries correspond to the number of the facet or panel.

In plotly one could prevent the duplicated legend entries via the legendgroup argument. One option to achieve the same result when using ggplotly would be to assign the legendgroup manually like so:

library(plotly)
library(ggplot2)

p <- mpg %>% 
  ggplot(aes(year)) +
  geom_ribbon(aes(ymin=cty, ymax=hwy, fill = manufacturer), alpha=0.2) + 
  geom_line(aes(y = hwy, col=manufacturer))  +
  facet_wrap(~class)

gp <- ggplotly(p = p)

# Get the names of the legend entries
df <- data.frame(id = seq_along(gp$x$data), legend_entries = unlist(lapply(gp$x$data, `[[`, "name")))
# Extract the group identifier
df$legend_group <- gsub("^\\((.*?),\\d+\\)", "\\1", df$legend_entries)
# Add an indicator for the first entry per group
df$is_first <- !duplicated(df$legend_group)

for (i in df$id) {
  # Is the layer the first entry of the group?
  is_first <- df$is_first[[i]]
  # Assign the group identifier to the name and legendgroup arguments
  gp$x$data[[i]]$name <- df$legend_group[[i]]
  gp$x$data[[i]]$legendgroup <- gp$x$data[[i]]$name
  # Show the legend only for the first layer of the group 
  if (!is_first) gp$x$data[[i]]$showlegend <- FALSE
}
gp

Answer 2

Thanks, @stefan, for your excellent answer that has both taught me about plotly objects and inspired me to take your concept further.

I've created this function with the following features:

1. It translates your logic into a function that uses the plotly object as an input.
2. It applies the purrr library.
3. The function accepts an optional second parameter (.new_legend) that allows overwriting the legend entries.

The code is certainly longer than your code, though it's elongated by the function, assign_leg_grp, that enables overwriting and also by my "spread out" style.

library(plotly)
library(ggplot2)
library(purrr)
library(stringr)

p <- mpg %>% 
  ggplot(aes(year)) +
  geom_ribbon(aes(ymin=cty, ymax=hwy, fill = manufacturer), alpha=0.2) + 
  geom_line(aes(y = hwy, col=manufacturer))  +
  facet_wrap(~class)

gp <- ggplotly(p = p)

clean_pltly_legend <- function(.pltly_obj, .new_legend = c()) {
  # Cleans up a plotly object legend, particularly when ggplot is facetted
  
  assign_leg_grp <- function(.legend_group, .leg_nms) {
    # Assigns a legend group from the list of possible entries
    # Used to modify the legend settings for a plotly object
    
    leg_nms_rem <- .leg_nms
    
    parse_leg_nms <- function(.leg_options) {
      # Assigns a .leg_name, if possible
      # .leg_options is a 2-element list: 1 = original value; 2 = remaining options
      
      if (is.na(.leg_options)) {
        .leg_options
      } else if(length(leg_nms_rem) == 0) {
        # No more legend names to assign
        .leg_options
      } else {
        # Transfer the first element of the remaining options
        leg_nm_new <- leg_nms_rem[[1]]
        leg_nms_rem <<- leg_nms_rem[-1]
        
        leg_nm_new
      }
      
    }
    
    .legend_group %>% 
      map(~ parse_leg_nms(.))
    
  }
  
  simplify_leg_grps <- function(.legendgroup_vec) {
    # Simplifies legend groups by removing brackets, position numbers and then de-duplicating
    
    leg_grp_cln <-
      map_chr(.legendgroup_vec, ~ str_replace_all(., c("^\\(" = "", ",\\d+\\)$" = "")))
    
    modify_if(leg_grp_cln, duplicated(leg_grp_cln), ~ NA_character_)
    
  }
  
  pltly_obj_data <-
    .pltly_obj$x$data
  
  pltly_leg_grp <-
    # pltly_leg_grp is a character vector where each element represents a legend group. Element is NA if legend group not required or doesn't exist
    pltly_obj_data%>% 
    map(~ pluck(., "legendgroup")) %>% 
    map_chr(~ if (is.null(.)) {NA_character_} else {.}) %>%
    # Elements where showlegend = FALSE have legendgroup = NULL. 
    
    simplify_leg_grps() %>% 
    
    assign_leg_grp(.new_legend) 
  
  pltly_obj_data_new <-
    pltly_obj_data %>% 
    map2(pltly_leg_grp, ~ list_modify(.x, legendgroup = .y)) %>%
    map2(pltly_leg_grp, ~ list_modify(.x, name = .y)) %>%
    map2(pltly_leg_grp, ~ list_modify(.x, showlegend = !is.na(.y)))
  # i.e. showlegend set to FALSE when is.na(pltly_leg_grp), TRUE when not is.na(pltly_leg_grp)
  
  .pltly_obj$x$data <- pltly_obj_data_new
  
  .pltly_obj
  
}

clean_pltly_legend(gp)