使用 facet_wrap 从 ggplot 进行绘图转换时避免图例重复

Question

考虑由以下 reprex 生成的图。请注意，ggplot 具有合理的图例，而在 plotly 中，图例被大量重复，每次在每个方面出现相同类别（“制造商”）时都有一个条目。如何使情节图例与 ggplot2 的图例更好地匹配？

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

调整我对 post to your case (which draws on this answer 的回答）一种选择是操纵 plotly 对象。

问题在于，对于分面，我们最终为存在一组的每个分面得到一个图例条目，即图例条目中的数字对应于分面或面板的编号。

在 plotly 中，可以通过 legendgroup 参数防止重复的图例条目。使用 ggplotly 时获得相同结果的一种选择是像这样手动分配 legendgroup：

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

谢谢@stefan，你的出色回答既教会了我关于情节对象的知识，也启发了我进一步推进你的概念。

我创建的这个函数具有以下特点：

它将您的逻辑转换为使用 plotly 对象作为输入的函数。
它应用了 purrr 库。
该函数接受一个可选的第二个参数 (.new_legend)，允许覆盖图例条目。

代码肯定比你的代码长，虽然它被功能拉长了，assign_leg_grp，它允许覆盖，也被我的“展开”风格。

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)

使用 facet_wrap 从 ggplot 进行绘图转换时避免图例重复

Avoid legend duplication in plotly conversion from ggplot with facet_wrap

r

ggplot2

plotly

r-plotly